SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00023 1 08-24-9413:25ALL PAUL KAHLER Rotate 256x256 bitmap SWAG9408 ▌N∞Å 57 Üd {$A+,B-,D+,E+,F-,G+,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V-,X+,Y+}π{$M 16384,0,32786}πProgram BitMap; { rotates/pans/scales a 256x256 bitmap }πUSES CRT; { by Paul H. Kahler Jan 1994 }ππVar SinTable,CosTable: Array[0..255] of integer;π Sin2Table,Cos2Table: Array[0..255] of integer;π Map:word; {used as a pointer to the bitmap}ππProcedure MakeTables; {Creates sin/cos tables}πVar direction:integer;π angle:real;πbeginπ For Direction:=0 to 255 do begin {use 256 degrees in circle}π angle:=Direction;π angle:=angle*3.14159265/128;π SinTable[Direction]:=round(Sin(angle)*256);π CosTable[Direction]:=round(Cos(angle)*256);π Sin2Table[Direction]:=round(Sin(angle+3.14159265/2)*256*1.2);π Cos2Table[Direction]:=round(Cos(angle+3.14159265/2)*256*1.2);π end; { the 1.2 accounts for pixel aspect ratio }πend;ππProcedure DrawScreen(x,y,scale:word; rot:byte);πvar Temp:Longint; {used for intermediate large values}π ddx,ddy,d2x,d2y:integer;π i,j:word;π label hloop,vloop,nodraw;ππbeginπ{ the following 8 lines of code calculate a 'right' and 'down' vector usedπ for scanning the source bitmap. I use quotes because these directionsπ depend on the rotation. For example, with a rotation, 'right' could meanπ up and to the left while 'down' means up and to the right. Since theπ destination image (screen) is scanned left-right/top-bottom, the bitmapπ needs to be scanned in arbitrary directions to get a rotation. }ππ Temp:=(CosTable[rot]);Temp:=(Temp*Scale) div 256;π ddx:=Temp;π Temp:=(SinTable[rot]);Temp:=(Temp*Scale) div 256;π ddy:=Temp;ππ{ Different tables are used for the 'down' vector to account for the non-π square pixels in mode 13h (320x200). The 90 degree difference is builtπ into the tables. If you don't like that, then use (rot+64)and255 hereπ and take the pi/2 out of CreateTables. To each his own I guess. }ππ Temp:=(Cos2Table[rot]);Temp:=(Temp*SCALE) div 256;π d2x:=Temp;π Temp:=(Sin2Table[rot]);Temp:=(Temp*SCALE) div 256;π d2y:=Temp;ππ{ Since we want to rotate around the CENTER of the screen and not the upperπ left corner, we need to move 160 pixels 'left' and 100 'up' in the bitmap.}ππ i:=x-ddx*160-d2x*100; j:=y-ddy*160-d2y*100;ππ{ The following chunk of assembly does the good stuff. It redraws the entireπ screen by scanning left-right/top-bottom on screen while also scanning theπ bitmap in the arbitrary directions determined above. }ππ ASMπ push dsπ mov ax,[Map] {get segment of bitmap}π mov ds,axπ mov ax,$a000 {set es: to video memory}π mov es,axπ mov ax,0 {set ds: to upper left corner of}π mov di,ax {the video memory}π mov ax,[ddx] {this is just to speed things up later}π mov si,ax {add ax,si faster than add ax,[ddx] }π mov cx,200 {Number of rows on Screen}π vloop:π push cxπ mov ax,[i] {start scanning the source bitmap}π mov dx,[j] {at i,j which were calculated above.}π mov cx,320 {Number of coulumns on screen}π hloop:π add ax,si {add the 'right' vector to the current}π add dx,[ddy] {bitmap coordinates. 8.8 fixed point}π mov bl,ah { bx = 256*int(y)+int(x) }π mov bh,dhπ mov bl,[ds:bx] { load a pixel from source }π mov [es:di],bl { copy it to destination }π inc di { advance to next destination pixel }ππ {*** by repeating the above 7 instructions 5 times, and reducingπ the loop count to 64, I have hit 37fps on a 486-33 with aπ fast video card. ***}ππ loop hloop {End of horizontal loop}ππ mov ax,d2x { get the 'down' vector }π mov dx,d2yππ { add si,2 } {** uncomment this instr. for extra fun **}ππ add i,ax { i,j is the starting coords for a line }π add j,dx { so this moves down one line }π pop cx { get the row count back and loop }π loop vloop { End of verticle loop }π pop ds { Restore the ds }π end;πend;ππProcedure GraphMode; {start 320x200x256 mode}πbeginπ Asmπ Mov AH,00π Mov AL,13hπ Int 10hπ end;πend;ππProcedure AllocateMem; {returns a segment pointer for a 64K bitmap}πlabel noerror;πbeginπ asmπ mov ah,$48π mov bx,$1000 { request 64K }π int $21π jnc noerrorπ mov ax,0000π noerror: mov Map,ax { The segment pointer goes in Map }π end;π If Map=0 then beginπ Writeln('Could not allocate enough memory');π Writeln('Program ending...');π Halt;end;πend;ππProcedure GiveBackMem; {returns the memory used for the map to the system}πbeginπ asmπ mov ah,$49π mov dx,Mapπ mov es,dxπ int $21π end;πend;ππProcedure DrawImage; {draws a test image which shows some limitations.}ππ{ If anyone stuffs in code to load a picture in a standard formatπ (ie .gif .bmp etc..) I'd like if you send me a copy. Preferablyπ something simple. This will have to do for now. }ππVar x,y:integer;πBeginπ for x:=-32768 to 32767 do mem[Map:x]:=0;π for y:=0 to 15 do {this just frames the area}π for x:=y to 255 do beginπ mem[Map:Y*256+x]:=1;π mem[Map:X*256+y]:=2;π end;π for y:=16 to 47 do { this part show Aliasing effects }π for x:=16 to 255 do mem[Map:Y*256+x]:=2+(x and 1)+(y and 1);ππ for y:= -50 to 50 do { this draw the circles }π for x:= round(-sqrt(2500 - y*y)) to round(sqrt(2500 - y*y)) doπ mem[Map:(y+100)*256+x+100]:=5+(X*X+Y*Y) div 100;ππ for x:=0 to 100 do { These lines also show sampling effects }π for y:=0 to 8 doπ mem[Map:(Y*2560)+x+41100]:=5;πend;ππVar rot,dr:word;π x,y,dist,dd:word;ππBeginπ AllocateMem;π DrawImage;π MakeTables;π GraphMode;π x:=32768; y:=0; {this corresponds to (128,0) in fixed point}π rot:=0; dr:=1; {rotation angle and it's delta}π dist:=1200; dd:=65534; {distance to bitmap (sort of) and its delta}π repeatπ DrawScreen(x,y,dist,lo(rot));π rot:=rot+dr;π y:=y+128; {slow panning. 1/2 pixel per frame}π dist:=dist+dd;π if (dist=2000) or (dist=2) then dd:=-dd;π if random(150)=1 then dr:=random(7)-3;π until keypressed;π GiveBackMem;π ASM {back to 80x25}π MOV AX,3π INT 10hπ END;πend. 2 08-24-9413:25ALL JOSE CAMPIONE High intensity backgroundSWAG9408 i±{2 10 Üd {π The solutions proposed so far to this problem have ignoredπ the fact that there was a way to use high intensity back-π ground in CGA screens by direct addressing the video port.π The following procedure works with EGA/VGA as well as CGAπ (and possibly MDA?) videos:ππ (I skipped function GetAdapterType that should return theπ AdapterType as indicated).ππ -Jose-π }π procedure ToggleBlink(Blink: Boolean);π varπ Adapter : AdapterType;π regs : registers;π port_ : word;π beginπ Adapter:= GetAdapterType;π if Adapter in [CGA,MDA] then beginπ if Adapter = CGA then port_:= $03D8π else port_:= $03B8;π if not Blink then PortW[port_]:= MemW[$0040:$0065] and $00DFπ else PortW[port_]:= MemW[$0040:$0065] or $0020;π end elseπ if (Adapter in [VGAColor,EGAColor,VGAMono,EGAMono]) then beginπ if not Blink then regs.bl:= $00π else regs.bl:= $01;π regs.ah:= $10;π regs.al:= $03;π intr($10,regs);π end;π end;π 3 08-24-9413:26ALL BAS VAN GAALEN Set Border (BASM) SWAG9408 tf7 4 Üd { EM> Does anyone happen to know how to change the border color?}ππconst border:boolean=true;πprocedure setborder(col:byte); assembler;πasmπ xor ch,chπ mov cl,borderπ jcxz @outπ mov dx,3dahπ in al,dxπ mov dx,3c0hπ mov al,11h+32π out dx,alπ mov al,colπ out dx,alπ @out:πend;ππBEGINπSetBorder(1); { make it blue }πReadln;πSetBorder(0); { back to black }πEND. 4 08-24-9413:29ALL DAVID DAHL TEXTMODE COPPECOPPER2.PAS SWAG9408 ≤wO 95 Üd Program CopperExampleNo2;π{$G+} { Enable 286 Instructions }ππ{ }π{ Copper Example #2 }π{ Programmed by David Dahl }π{ }π{ THIS EXAMPLE RUNS IN TEXT MODE }π{ }π{ This is PUBLIC DOMAIN }π{ }πππ{ This Example Works FLAWLESSLY On My ET4000AX Based VGA Card. }π{ On My Friend's Trident, However, The Three Sinus Bars Have Snow }π{ Covering Their Leftmost Sides For About An Inch. This Is Due }π{ To The Double VGA DAC Set Required To Display Both The Sinus }π{ Bars And The Smooth Color Transitions Of The Large Text. }ππUses CRT;ππConst MaxRaster = 399;ππ Status1 = $3DA;π DACWrite = $3C8;π DACData = $3C9;ππType CopperRec = Recordπ Color : Byte;π Red : Byte;π Green : Byte;π Blue : Byte;π End;ππ CopperArray = Array [0..MaxRaster] of CopperRec;ππ BarArray = Array [0..19] of CopperRec;ππVar CopperList : CopperArray;ππ Bar : Array[0..2] of BarArray;π BarPos : Array[0..2] of Integer;ππ SinTab : Array[0..255] of Integer;ππ{-[ Build Sine Lookup Table ]----------------------------------------------}πProcedure MakeSinTab;πVar Counter : Integer;πBeginπ For Counter := 0 to 255 doπ SinTab[Counter] := 115 + Round(90 * Sin(Counter * PI / 128));πEnd;π{-[ Build Colors For Sinus Bars ]------------------------------------------}πProcedure MakeBars;πVar Counter : Integer;πBeginπ { Clear Colors }π FillChar (Bar, SizeOf(Bar), 0);ππ For Counter := 0 to 9 doπ Beginπ Bar[0][Counter].Red := Trunc(Counter * (63 / 9));π Bar[1][Counter].Green := Trunc(Counter * (63 / 9));π Bar[2][Counter].Blue := Trunc(Counter * (63 / 9));π If Odd(Counter)π Thenπ Beginπ Bar[0][Counter].Green := Trunc(Counter * (63 / 9));π Bar[1][Counter].Red := Trunc(Counter * (63 / 9));π Bar[1][Counter].Blue := Trunc(Counter * (63 / 9));π Bar[2][Counter].Green := Trunc(Counter * (63 / 9));π End;π End;π For Counter := 10 to 19 doπ Beginπ Bar[0][Counter].Red := Trunc((19-Counter) * (63 / 9));π Bar[1][Counter].Green := Trunc((19-Counter) * (63 / 9));π Bar[2][Counter].Blue := Trunc((19-Counter) * (63 / 9));π If Odd(Counter)π Thenπ Beginπ Bar[0][Counter].Green := Trunc((19-Counter) * (63 / 9));π Bar[1][Counter].Red := Trunc((19-Counter) * (63 / 9));π Bar[1][Counter].Blue := Trunc((19-Counter) * (63 / 9));π Bar[2][Counter].Green := Trunc((19-Counter) * (63 / 9));π End;π End;πEnd;π{-[ Make COPPER List ]-----------------------------------------------------}πProcedure MakeCopperList;πVar Counter1 : Integer;π Counter2 : Integer;πBeginπ { Clear List }π FillChar (CopperList, SizeOf(CopperList), 0);ππ { Make Transition From White To Yellow For }π { Color 1 On Scanlines 10 Through 250 }π For Counter1 := 10 to 250 doπ With CopperList[Counter1] doπ Beginπ Color := 1;π Red := 63;π Green := 63;π Blue := Round((250 - Counter1) * (63 / 200));π End;ππ { Make Transition From Black To Dark Blue For }π { Color 0 On Scanlines 254 Through 274 }π For Counter1 := 254 to 254 + 20 doπ With CopperList[Counter1] doπ Beginπ Color := 0;π Red := 0;π Green := 0;π Blue := Counter1 - 254;π End;π { Make Dark Blue Background (Color 0) For }π { Scanlines 275 Through 287 Except Scanline }π { 280 Which Is Yellow }π For Counter1 := 275 to 287 doπ With CopperList[Counter1] doπ Beginπ Color := 0;π Red := 0;π Green := 0;π If Counter1 = 280π Thenπ Beginπ Red := 45;π Green := 45;π Endπ Elseπ Blue := 20;π End;π { Make Dark Blue Background (Color 0) For }π { Scanlines 336 Through 394 Except Scanline }π { 343 Which Is Yellow }π For Counter1 := 336 to 349 doπ With CopperList[Counter1] doπ Beginπ Color := 0;π Red := 0;π Green := 0;π If Counter1 = 343π Thenπ Beginπ Red := 45;π Green := 45;π Endπ Elseπ Blue := 20;π End;π { Make Transition From Dark Blue To Black }π { For Background From Scanline 350 to 370 }π For Counter1 := 350 to 350 + 20 doπ With CopperList[Counter1] doπ Beginπ Color := 0;π Red := 0;π Green := 0;π Blue := (350 + 20 - Counter1);π End;ππ { Color Text Lines 18, 19, and 20 For Text Color 1 }π { As Red -> Yellow (L18), Purple -> White (L20) }π For Counter1 := 18 to 20 doπ For Counter2 := 0 to 15 doπ With CopperList[Counter2 + (Counter1 * 16)] doπ Beginπ Color := 1;π Red := 63;π Green := Trunc(Counter2 * (63 / 15));π Blue := ((Counter1 - 18) * 31) AND 63;π End;πEnd;π{-[ Center And Write A String As Solid Chars And Spaces ]------------------}πProcedure WSol (StringIn : String);πVar Counter : Integer;πBeginπ For Counter := 1 to (40 - (Length(StringIn) DIV 2)) doπ Write(#32);ππ For Counter := 1 to Length(StringIn) doπ If StringIn[Counter] <> #32π Thenπ Write (#219)π Elseπ Write (#32);ππ Writeln;πEnd;π{-[ Put Text On Screen ]---------------------------------------------------}πProcedure SetUpScreen;πBeginπ ClrScr;ππ GotoXY (1,5);π TextColor (1);π WSol(' #### #### ###### ###### ######## ###### ');π WSol(' ## ## ## ## ## ## ## ## ## ## ## ');π WSol('## ## ## ## ## ## ## ## ## ##');π WSol('## ## ## ## ## ## ## ##### ## ##');π WSol('## ## ## ## ## ## ## ## ## ## ');π WSol('## ## ## ###### ###### ## ###### ');π WSol(' ## ## ## ## ## ## ## ## ## ');π WSol(' #### #### ## ## ######## ## ##');π GotoXY(21, 19);π Writeln('Textmode COPPER Example #2 by David Dahl');π GotoXY(27, 21);π Writeln('This Program is Public Domain');πEnd;π{-[ Update COPPER ]--------------------------------------------------------}πProcedure UpdateCopper;πVar Raster : Word;π DrawBar : Integer;π BarNum : Integer;π BarCounter : Integer;πBeginπ Raster := 1;ππ DrawBar := -1;π BarNum := 0;ππ Inc(BarPos[0],1);π Inc(BarPos[1],1);π Inc(BarPos[2],1);ππ { Sorry For All The Assembly Here, But Plain Vanilla Pascal }π { Just Isn't Fast Enough To Properly Display BOTH Sinus Bars }π { And The Color Transitions For The Large Text. }π ASMπ PUSH DSπ MOV AX, SEG @Dataπ MOV DS, AXπ CLIππ { Wait For End Of Vertical Retrace }π MOV DX, Status1π @NotVert:π IN AL, DXπ AND AL, 8π JNZ @NotVertπ @IsVert:π IN AL, DXπ AND AL, 8π JZ @IsVertπππ @DrawAllBarsLoop:π {--- Check For Bars ---}π MOV CX, 3π @BarRasterCompare:ππ { Calculate Location of Bar (Start Line Placed In AX) }π MOV BX, CXπ DEC BXπ SHL BX, 1π MOV BX, word(BarPos[BX])π AND BX, 255π SHL BX, 1π MOV AX, word(SinTab[BX])ππ { Check If A Bar Is On Current Raster }π CMP AX, Rasterπ JNS @BarNotDisplayedπ MOV BX, AXπ ADD AX, 20π CMP Raster, AXπ JNS @BarNotDisplayedππ { Bar Is On Raster So Mark It }π SUB BX, Rasterπ XOR AX, AXπ SUB AX, BXππ MOV word(DrawBar), AXπ MOV word(BarNum), CXπ DEC word(BarNum)ππ @BarNotDisplayed:π @DoneChecking:π LOOP @BarRasterCompareππ {--- Draw Bars ---}π MOV BX, DrawBarπ OR BX, BXπ JL @NoDrawBarππ { Build Index To Bar Color Table }π SHL BX, 2ππ MOV AX, word(BarNum)π MOV CX, AXπ SHL AX, 6π SHL CX, 4π ADD AX, CXπ ADD BX, AXππ { Set Up Next Scan Line Color }π MOV DX, DACWRITEπ XOR AX, AXπ OUT DX, ALππ MOV DX, DACDATAπ INC BXπ MOV AL, Byte(Bar[BX])π OUT DX, ALπ INC BXπ MOV AL, Byte(Bar[BX])π OUT DX, ALππ { Wait For End of Horiz Retrace }π MOV DX, Status1π @NotHoriz1:π IN AL, DXπ AND AL, 1π JNZ @NotHoriz1π @IsHoriz1:π IN AL, DXπ AND AL, 1π JZ @IsHoriz1ππ { Send Last Byte Of DAC Reg So Color Is Updated }π MOV DX, DACDATAπ INC BXπ MOV AL, byte(Bar[BX])π OUT DX, ALππ { Update Color From Copper Table }π MOV DX, DACWRITEπ MOV BX, Rasterπ SHL BX, 2π MOV AL, Byte(CopperList[BX])π OUT DX, ALππ MOV DX, DACDATAπ INC BXπ MOV AL, Byte(CopperList[BX])π OUT DX, ALπ INC BXπ MOV AL, Byte(CopperList[BX])π OUT DX, ALπ INC BXπ MOV AL, Byte(CopperList[BX])π OUT DX, ALππ JMP @Doneππ @NoDrawBar:π { Update Color }π MOV DX, DACWRITEπ MOV BX, Rasterπ SHL BX, 2π MOV AL, Byte(CopperList[BX])π OUT DX, ALππ MOV DX, DACDATAπ INC BXπ MOV AL, Byte(CopperList[BX])π OUT DX, ALπ INC BXπ MOV AL, Byte(CopperList[BX])π OUT DX, ALππ { Wait For End of Horiz Retrace }π MOV DX, Status1π @NotHoriz2:π IN AL, DXπ AND AL, 1π JNZ @NotHoriz2π @IsHoriz2:π IN AL, DXπ AND AL, 1π JZ @IsHoriz2ππ { Update Last }π MOV DX, DACDATAπ INC BXπ MOV AL, Byte(CopperList[BX])π OUT DX, ALππ @Done:ππ INC Word(Raster)ππ { If Raster <= 250 Then Loop }π CMP Word(Raster), 250π JLE @DrawAllBarsLoopππ {--- Color Background And Text At Bottom of Screen ---}π @TextColorLoop:π MOV DX, DACWRITEπ MOV BX, Rasterπ SHL BX, 2π MOV AL, Byte(CopperList[BX])π OUT DX, ALππ MOV DX, DACDATAπ INC BXπ MOV AL, Byte(CopperList[BX])π OUT DX, ALπ INC BXπ MOV AL, Byte(CopperList[BX])π OUT DX, ALππ MOV DX, Status1π @NotHoriz3:π IN AL, DXπ AND AL, 1π JNZ @NotHoriz3π @IsHoriz3:π IN AL, DXπ AND AL, 1π JZ @IsHoriz3ππ MOV DX, DACDATAπ INC BXπ MOV AL, Byte(CopperList[BX])π OUT DX, ALππ INC Word(Raster)π CMP Word(Raster), MaxRasterπ JLE @TextColorLoopπ STIπ POP DSπ END;πEnd;π{=[ Main Program ]=========================================================}πVar Key : Char;πBeginπ TextMode (C80);π MakeSinTab;π MakeCopperList;π MakeBars;π SetUpScreen;π BarPos[0] := 30;π BarPos[1] := 15;π BarPos[2] := 0;π Repeatπ UpdateCopper;π Until Keypressed;π While Keypressed doπ Key := ReadKey;π TextMode (C80);πEnd.ππ 5 08-24-9413:29ALL YVES HETZER Cube SWAG9408 ▌τt┴ 102 Üd program cube; { Author: Yves Hetzer 2:248/1003.8 }πuses crt; { Erfurt, Germany }ππconst gCrtc = $3d4; gScreensize = 400*80;π gscreenPage0 = $0000; gScreenpage1 = gscreensize;π gscreensegment = $0a000; gscrwidth = 80; scal= 20;π sintab : array[0..90] of byte = (0,4,9,13,18,22,27,31,36,40,44,49,53,58,62,66,71,75,79,83,88,π 92,96,100,104,108,112,116,120,124,128,132,136,139,143,147,150,154,158,161,165,π 168,171,175,178,181,184,187,190,193,196,199,202,204,207,210,212,215,217,219,222,π 224,226,228,230,232,234,236,237,239,241,242,243,245,246,247,248,249,250,251,252,π 253,254,254,254,255,255,255,255,255,255);ππtype tupel = recordπ x,y,z : integer;π end;π rtupel = recordπ x,y,z : real;π end;π PointType = recordπ X, Y : integer;π end;π bild_point = array[1..12] of rtupel;π kehrtab = array [1..10000] of real;ππconst pk : bild_point =((x:0;y:6;z:0),(x:2;y:2;z:2),(x:-2;y:2;z:2),π (x:2;y:2;z:-2),(x:-2;y:2;z:-2),(x:2;y:-2;z:2),(x:-2;y:-2;z:2),π (x:2;y:-2;z:-2),(x:-2;y:-2;z:-2),(x:0;y:-6;z:0),(x:6;y:0;z:0),π (x:-6;y:0;z:0));ππvar scrofs, hlength, scrmemoff,offs,gscreen : word;π bit_maske :byte;π rp : array[1..3,1..3] of real;π pd : bild_point;π u,v: array[1..12] of integer;π lauf,al,ga,f,leftb,rightb,upb,downb,help : integer;π eck : array [0..4] of pointtype;π kehrt:^kehrtab;π rmask,lmask:array [0..639] of byte;ππprocedure waitblank;πassembler;πasm;πmov dx,gCRTC+6;@g_r: in al,dx;test al,8;jz @g_r;@g_d: in al,dx;πtest al,8;jnz @g_dπend;ππprocedure calcxy;πassembler;πasm;π mov cx,ax;mov ax,80;mul bx;mov dx,0a000h;push dx;mov dx,ax;π mov ax,cx;shr ax,1;shr ax,1;shr ax,1;add dx,ax;mov di,dx;π and cl,7;mov dl,80h;shr dl,cl;pop es;mov ax,gscreen;add di,ax;π mov ds:[offs], di;mov ds:[bit_maske],dlπend;ππprocedure set_dot(x,y,farbe : word);πassembler;πasm;π mov ax,x;mov bx,y;mov cx,farbe;call calcxy;mov ah,bit_maske;π mov dx,3ceh;mov al,08h;out dx,ax;mov ax,0a000h;mov es,ax;π mov di,offs;mov cx,farbe;mov ch,[es:di];mov [es:di], cl;πend;ππprocedure graph_init;πassembler;πasm;π mov ax,0012h;int 10h;mov dx,3ceh;mov ax,0205h;out dx,ax;mov ax,1003h;π out dx,ax; end;ππPROCEDURE Draw(xA,yA,xB,yB,col:Integer); { DRAWALL.INC }πVARπ x,y,kriterium,dX,dY,stepX,stepY:Integer;πBEGINπ dX:=Abs(xB-xA);π dY:=Abs(yB-yA);π IF dX=0 THEN kriterium:=0 ELSE kriterium:=Round(-dX/2);π IF xB>xA THEN stepX:=1 ELSE stepX:=-1;π IF yB>yA THEN stepY:=1 ELSE stepY:=-1;π x:=xA;y:=yA;π set_dot(x,y,col);π WHILE Not ((x=xB) And (y=yB)) DOπ BEGINπ IF kriterium <0 THENπ BEGINπ x:=x+stepX; kriterium:=kriterium+dY;π END;π IF (kriterium>=0) And ( y<>yB) THENπ BEGINπ y:=y+stepY; kriterium:=kriterium-dX;π END;π set_dot(x,y,col);π END;πEND;ππprocedure hline(x1,x2:integer);πvar y : word;πBeginπ if x1>x2 then Begin help := x2;x2:=x1;x1:=help;end;π help := x1 shr 3;π scrofs := help + scrmemoff;π hlength := x2 shr 3 - help;π if hlength = 0 thenπ Beginπ port[$3cf] := lmask[x1] and rmask[x2];π inc (mem[$a000:scrofs]);π end elseπ if hlength > 1 thenπ Beginπ port[$3cf] := lmask[x1];π inc (mem[$a000:scrofs]);π port [$3cf] := $ff;π for lauf := 1 to hlength-1 do inc(mem[$a000:scrofs+lauf]);π port [$3cf] := rmask[x2];π inc (mem[$a000:scrofs+hlength]);π end elseπ Beginπ port [$3cf] := lmask [x1];π inc (mem[$a000:scrofs]);π port [$3cf] := rmask [x2];π inc (mem[$a000:scrofs+1]);π end;πend;ππprocedure fillfourangle(var x1,y1,x2,y2,x3,y3,x4,y4,ficol:integer);πvar ho1,ho2,ho3,ho4,ypos,start,ende,diff,counter1,counter2,polyho,π ya,ye,yr,yl,dy : integer;π stepx1,stepx2,stepx3,stepx4,links,rechts,xa,xe,xr,xl : longint;π sre,ore,sl,ol : word;π trapez,clip : boolean;π stepx : real;πprocedure height (var h : integer);πBeginπ if h = 0 then h := 1 else if h > 5000 then h := 5000;πend;πBeginπasm;mov dx,3ceh;mov ax,0005h;out dx,ax;mov ax,1003h;out dx,ax;end;π if ((x1<leftb) and (x2<leftb) and (x3<leftb) and (x4<leftb)) orπ ((x1>rightb) and (x2>rightb) and (x3>rightb) and (x4> rightb)) then exit;π clip := false;π if (x1<=leftb) or (x2<=leftb) or (x3<=leftb) or (x4<=leftb) orπ (x1>=rightb) or (x2 >= rightb) or (x3 >= rightb) or (x4>=rightb) then clip :=πtrue;π eck[1].x := x1;eck[2].x := x2;eck[3].x := x3;eck[4].x := x4;π eck[1].y := y1;eck[2].y := y2;eck[3].y := y3;eck[4].y := y4;π for start := 1 to 3 doπ for ende := 4 downto start doπ if eck[start].y > eck[ende].y then beginπ eck[0] := eck[start];π eck[start] := eck[ende];π eck[ende] := eck[0];π end;π polyho := eck[4].y-eck[1].y;π if (eck[1].y > downb) or (eck[4].y < upb) or (polyho < 1) then exit;π dy := eck[4].y - eck[1].y;π if dy = 0 then dy := 1;π if dy < 5000 then stepx := (eck[4].x-eck[1].x)*kehrt^[dy] elseπ stepx := (eck[4].x-eck[1].x)/dy;π xa := trunc ((eck[2].y-eck[1].y)*stepx+eck[1].x);π xe := trunc (eck[4].x-(eck[4].y-eck[3].y)*stepx);π if ((xa<eck[2].x)and(xe<eck[3].x)) or ((xa>eck[2].x) and (xe>eck[3].x))π then trapez := true else trapez := false;π xa := eck[1].x; xa := xa * 256;ya := eck[1].y; xe := eck[4].x;π xe := xe * 256; ye := eck[4].y;xl := eck[2].x; xl := xl * 256;π yl := eck[2].y; xr := eck[3].x;xr := xr * 256; yr := eck[3].y;πif not trapez thenπBeginπ ho1 := abs(yr-ya);ho2 := abs(ye-yr);height (ho1);height (ho2);π stepx1 := trunc((xr-xa)*kehrt^[ho1]);stepx2 := trunc((xe-xr)*kehrt^[ho2]);π ho4 := abs(yl-ya);ho3 := abs(ye-yl);height (ho4);height (ho3);π stepx4 := trunc((xl-xa)*kehrt^[ho4]);stepx3 := trunc((xe-xl)*kehrt^[ho3]);πend elseπBeginπ ho1 := abs(yl-ya);ho2 := abs(yr-yl);height (ho1);height (ho2);π stepx1 := trunc((xl-xa)*kehrt^[ho1]);stepx2 := trunc((xr-xl)*kehrt^[ho2]);π ho4 := abs(ye-ya);ho3 := abs(ye-yr);height (ho4);height (ho3);π stepx4 := trunc((xe-xa)*kehrt^[ho4]);stepx3 := trunc((xe-xr)*kehrt^[ho3]);πend;π port[$3ce] := 1; port[$3cf] := $0f;port[$3ce] := 0; port[$3cf]:=ficol;π port[$3ce] := 8;π links := xa; rechts := links; start := ya; ende := start + polyho - 1;π counter1:= 0; counter2 :=0;π if start < upb then Beginπ diff := upb - start;inc (start,diff);inc (counter1,diff);π if not trapez then Beginπ inc (counter2,diff);π if counter2<ho4 then inc (links,diff*stepx4)π else links := xl + (upb-yl)*stepx3;π if counter1<ho1 then inc(rechts,diff*stepx1)π else rechts := xr + (upb-yr)*stepx2;π end else Beginπ inc(links,diff*stepx4);π if counter1<ho1 then inc(rechts,diff*stepx1)π else Beginπ inc (counter2,diff-ho1);π if counter2 < ho2 then rechts := xl + (upb-yl)*stepx2π else rechts := xr + (upb-yr)*stepx3;π end;π end;π end;π scrmemoff := gscreen+start*gscrwidth;π if ende > downb then ende := downb;π sl := seg(links);ol := ofs(links)+1;sre := seg(rechts);ore := ofs(rechts)+1;π if not trapez thenπ beginπ for ypos := start to ende doπ beginπ if counter2< ho4 thenπ Beginπ inc(links,stepx4);inc(counter2);π end else inc(links,stepx3);π if counter1<ho1 thenπ beginπ inc(rechts,stepx1);inc(counter1);π end else inc (rechts,stepx2);π hline(memw[sl:ol],memw[sre:ore]);π inc(scrmemoff,gscrwidth);π end;π end elseπ beginπ for ypos := start to ende doπ beginπ inc(links,stepx4);π if counter1<ho1 thenπ beginπ inc(rechts,stepx1);inc(counter1);π end elseπ if counter2<ho2 thenπ beginπ inc(rechts,stepx2);inc(counter2);π end else inc(rechts,stepx3);π hline(memw[sl:ol],memw[sre:ore]);π inc(scrmemoff,gscrwidth);π end;π end;πport [$3cf] := $ff; port[$3ce] := 1;port [$3cf] := 0; port [$3ce] := 0;πport [$3cf] := 15;πend;ππprocedure setrgbpalette(i,r,g,b : byte);πbeginπasm;mov dx,3c8h;mov al,i;out dx,al;inc dx;mov al,r;out dx,ax;mov al,g;πout dx,al;mov al,b;out dx,al;end;end;ππfunction csin(winkel :integer): integer;πbeginπwhile winkel < 0 do winkel := winkel + 360;πwinkel := winkel mod 360;πif (winkel >= 0) and (winkel <= 90) then csin := sintab[winkel];πif (winkel > 90) and (winkel <= 180) then csin := sintab[180-winkel];πif (winkel > 180) and (winkel <= 270) then csin := -sintab[winkel-180];πif (winkel > 270) and (winkel <= 360) then csin := -sintab[360-winkel];πend;ππfunction ccos(winkel :integer): integer;πbeginπwinkel := winkel+ 90;πwhile winkel < 0 do winkel := winkel + 360;πwinkel := winkel mod 360;πccos := csin(winkel);πend;ππprocedure gstartaddr(addr : word);πassembler;πasm;πmov bx,addr;push ds;mov dx,gCRTC;mov ah,bh;mov al,0ch;out dx,ax;πmov ah,bl;mov al,0dh;out dx,ax;mov cx,0040h;mov ds,cx;πmov word ptr ds:[004eh],bx;pop ds;end;ππprocedure waehle_seite (seite : byte);πbeginπgscreen := seite * gscreensize;πend;ππprocedure zeige_seite(seite : byte);πvar adr : word;πbeginπ adr := seite * gscreensize;π gstartaddr (adr);πend;ππprocedure wechsel5;ππbeginπif gscreen = gscreenpage0 then beginπ zeige_seite(0); waehle_seite(1); endπ else beginπ zeige_seite(1); waehle_seite(0);π end;πend;ππprocedure gclear;πassembler;πasm;πmov ax,gscreensegment;mov es,ax;mov al,es:[0];mov di,gscreen;mov dx,3ceh;πmov ax,0205h;out dx,ax;mov ax,0003h;out dx,ax;mov ax,0ffffh;out dx,ax;πmov ax,$00;mov cx,gscreensize/2;rep stosw;mov dx,3ceh;mov ax,0205h;out dx,ax;πmov ax,1003h;out dx,ax;end;ππprocedure dreh_m;πvar x,y,u,v : real;πbeginπ x:=csin(ga)/256; y:=ccos(al)/256; u:=csin(al)/256; v:=ccos(ga)/256;π rp[1,1]:=v; rp[2,1]:=x; rp[3,1]:=0; rp[1,2]:=y*x; rp[2,2]:=y*v; rp[3,2]:=-u;π rp[1,3]:=u*x; rp[2,3]:=u*v; rp[3,3]:=y;end;ππprocedure dreh(var x:rtupel);πvar temp:rtupel;πbeginπ temp.x:=(x.x*rp[1,1]+x.y*rp[1,2]+x.z*rp[1,3]) * scal;π temp.y:=(x.x*rp[2,1]+x.y*rp[2,2]+x.z*rp[2,3])*scal;π temp.z:=(x.y*rp[3,2]+x.z*rp[3,3])*scal;π x:=temp;πend;ππprocedure zeichnen;πbeginπfor lauf := 1 to 12 do beginπu[lauf] := round(pd[lauf].x)+320;v[lauf] := round(pd[lauf].z)+200;end;ππdraw(u[1],v[1],u[2],v[2],1);draw(u[1],v[1],u[4],v[4],1);πdraw(u[1],v[1],u[3],v[3],1);draw(u[1],v[1],u[5],v[5],1);πdraw(u[2],v[2],u[3],v[3],1);draw(u[2],v[2],u[4],v[4],1);πdraw(u[3],v[3],u[5],v[5],1);draw(u[5],v[5],u[4],v[4],1);πdraw(u[6],v[6],u[7],v[7],1);draw(u[6],v[6],u[8],v[8],1);πdraw(u[7],v[7],u[9],v[9],1);draw(u[9],v[9],u[8],v[8],1);πdraw(u[2],v[2],u[6],v[6],1);draw(u[3],v[3],u[7],v[7],1);πdraw(u[4],v[4],u[8],v[8],1);draw(u[5],v[5],u[9],v[9],1);πdraw(u[10],v[10],u[6],v[6],1);draw(u[10],v[10],u[7],v[7],1);πdraw(u[10],v[10],u[8],v[8],1);draw(u[10],v[10],u[9],v[9],1);πdraw(u[11],v[11],u[6],v[6],1);draw(u[11],v[11],u[2],v[2],1);πdraw(u[11],v[11],u[8],v[8],1);draw(u[11],v[11],u[4],v[4],1);πdraw(u[12],v[12],u[3],v[3],1);draw(u[12],v[12],u[5],v[5],1);πdraw(u[12],v[12],u[7],v[7],1);draw(u[12],v[12],u[9],v[9],1); end;ππprocedure initkehrtaB;πvar a: word;πbegin new (kehrt); for a:= 1 to 10000 do kehrt^[a] := 1/a; end;ππprocedure initmasktab;πvar a,wert : word;πbeginπ for a:= 0 to 639 doπ beginπ lmask[a]:=$ff shr (a and 7);wert := $ff shl (7-(a and 7));π rmask[a] := lo(wert); end;end;ππprocedure gexit;πassembler; asm;push ax;xor ah,ah;mov al,3h;int 10h;pop ax;end;πππbeginπ graph_init;π setrgbpalette(1,63,0,0); setrgbpalette(2,0,42,0); setrgbpalette(3,10,63,10);π setrgbpalette(4,42,0,0); setrgbpalette(5,63,10,10);setrgbpalette(6,42,21,0);π setrgbpalette(7,42,42,42);π gscreen := 0; initkehrtab; initmasktab;π al := 0; ga := 0;leftb := 10;upb := 10;rightb := 600;downb := 400;π repeatπ dec(al,5);ga := ga + csin(al) div 25+csin(ga) div 50;pd := pk;π dreh_m;for lauf := 1 to 12 do dreh(pd[lauf]);π zeichnen;f := 2;π fillfourangle(u[1],v[1],u[4],v[4],u[5],v[5],u[1],v[1],f);π fillfourangle(u[1],v[1],u[2],v[2],u[3],v[3],u[1],v[1],f);π fillfourangle(u[1],v[1],u[5],v[5],u[3],v[3],u[1],v[1],f);π fillfourangle(u[1],v[1],u[2],v[2],u[4],v[4],u[1],v[1],f);f := 4;π fillfourangle(u[11],v[11],u[2],v[2],u[6],v[6],u[11],v[11],f);π fillfourangle(u[11],v[11],u[4],v[4],u[8],v[8],u[11],v[11],f);π fillfourangle(u[11],v[11],u[6],v[6],u[8],v[8],u[11],v[11],f);π fillfourangle(u[11],v[11],u[2],v[2],u[4],v[4],u[11],v[11],f);f := 2;π fillfourangle(u[10],v[10],u[8],v[8],u[9],v[9],u[10],v[10],f);π fillfourangle(u[10],v[10],u[6],v[6],u[7],v[7],u[10],v[10],f);π fillfourangle(u[10],v[10],u[9],v[9],u[7],v[7],u[10],v[10],f);π fillfourangle(u[10],v[10],u[6],v[6],u[8],v[8],u[10],v[10],f);f := 4;π fillfourangle(u[12],v[12],u[3],v[3],u[7],v[7],u[12],v[12],f);π fillfourangle(u[12],v[12],u[5],v[5],u[9],v[9],u[12],v[12],f);π fillfourangle(u[12],v[12],u[3],v[3],u[5],v[5],u[12],v[12],f);π fillfourangle(u[12],v[12],u[7],v[7],u[9],v[9],u[12],v[12],f);π wechsel5; waitblank; gclear;π until keypressed;πdispose(kehrt);gexit;end.π 6 08-24-9413:31ALL PATRICK ROBERTS Set Border Colors SWAG9408 ½# 11 Üd πprogram Demo_4_SWAG;πvarπ old_border : integer; { used in main body of program }π Rnd_border : integer;ππ(****************************************************************************)πprocedure Set_Border(color:byte); { Written by Pat Roberts 1994 }πbeginπ asmπ mov ah,10h { This subroutine sets the color value stored in the }π mov al,01h { overscan register of the current palette from the }π mov BH,Color { Bios thru int 10h . Assumes EGA\VGA }π int 10hπ end;πend;ππ(****************************************************************************)πfunction Get_Border:byte; { Written by Pat Roberts 1994 }πbeginπ asmπ mov ah,10h { This subroutine reads the color value stored in the }π mov al,08h { overscan register of the current palette from the }π int 10h { Bios thru int 10h. Assumes EGA\VGA }π mov @result,bH { result is byte(BL) not a integer(BX) }π end;πend;ππ(******************************Main******************************************)πbeginπ Randomize;π old_border := get_border;π writeln(' Old border color was ',old_border);π Rnd_border := ((random(7)+1));π set_border(rnd_border);π writeln(' Get_Border reports color ',get_border); readln; end.πend.π 7 08-24-9413:31ALL JASON KANE Loading FONT file SWAG9408 ┐╙J▓ 15 Üd {πRN> Hi! Does anyone know if it's possible to modify theπRN> characters in the ASCII chart using Pascal? The reason IπRN> want to do this is to define the upper ASCII charactersπRN> (128+) to implement the Cyrillic alphabet, for anπRN> application I'm developping (or will be developping if I canπRN> figure this out :-)))π}ππUnit Font;ππ{ AX = $1110 (ah = $11, al = $10)π BH = bytes per characterπ BL = block to load to. (use 0)π CX = number of character defined by tableπ DX = starting character valueπ ES = segment of the table (use Seg())π BP = offset of the table (use Ofs()) }πInterfaceππProcedure DoFont(Fname: String);ππImplementationππUses DOS;πType FontArray= Array[1..$1000] of Char;ππ FontFile= Recordπ Gfont_POINTS: Byte;π Gfont: FontArray;π End; {of record}πVAR FonF: File;π Tfont: FontFile;π ESr,BPr: Word;π{---------------------------------------------------------------------------}πProcedure DoFont(Fname: String);ππVAR R: Registers;ππBegin;πAssign (FonF,Fname+'.FON');πReset (FonF, SizeOf(FontFile));πBlockRead (FonF, Tfont, 1);πClose (FonF);πESr:= Seg(Tfont.Gfont);πBPr:= Ofs(Tfont.Gfont);πr.ax := $1110;πr.bh := Tfont.Gfont_Points; (* bytes per character *)πr.bl := 0; (* load to block 0 *)πr.cx := 256; (* 256 characters *)πr.dx := 0; (* start with character 0 *)πr.es := Seg(Tfont.Gfont); (* segment of table *)πr.bp := Ofs(Tfont.Gfont); (* offset of the table *)πintr($10, r);πEnd; {of procedure}ππEnd.π 8 08-24-9413:36ALL JUSTIN KING More Text Fading. SWAG9408 ╣fì~ 14 Üd { In Procdures FADEIN & FADEOUT, the (X) is the delay betweenπ screen darkenings. }ππ Unit Fade;π Interfaceππ Uses Crt;ππ Constπ PelAddrRgR = $3C7; π PelAddrRgW = $3C8; π PelDataReg = $3C9;ππ Typeπ RGB = Record π R, π G,π B : Byte;π End;π Color = Array [0..63] Of RGB; ππ Varπ Col : Color; πππ Procedure GetCol(C : Byte; Var R, G, B : Byte);π Procedure SetCol(C, R, G, B : Byte);π Procedure SetInten(B : Byte);π Procedure FadeIn (X:Integer);π Procedure FadeOut (X:Integer);ππ Implementationππ ππProcedure GetCol(C : Byte; Var R, G, B : Byte);πBeginπ Port[PelAddrRgR] := C;π R := Port[PelDataReg];π G := Port[PelDataReg];π B := Port[PelDataReg];πEnd;π πProcedure SetCol(C, R, G, B : Byte);πBeginπ Port[PelAddrRgW] := C;π Port[PelDataReg] := R;π Port[PelDataReg] := G;π Port[PelDataReg] := B;πEnd;ππProcedure SetInten(b : Byte);π Varπ I : Integer;π FR, FG, FB : Byte;π Beginπ For I:=0 To 63 Doπ Beginπ FR:=Col[I].R*B Div 63;π FG:=Col[I].G*B Div 63;π FB:=Col[I].B*B Div 63;π SetCol(I, FR, FG, FB);π End;π End;ππProcedure FadeIn (X:Integer);π Varπ Y:Integer; (* Y is the LCV *)π Beginπ For Y:=0 To 63 Doπ Beginπ SetInten(Y);π Delay(X);π End;π End;ππProcedure FadeOut (X:Integer);π Varπ Y:Integer; (* Y is the LCV *)π Beginπ For Y:=0 To 63 Doπ GetCol(Y, Col[Y].R, Col[Y].G, Col[Y].B);π For Y:=63 DownTo 0 Doπ Beginπ SetInten(Y);π Delay(X);π End;π End;πEnd.ππ 9 08-24-9413:36ALL DAVE JARVIS Text Screen Fading SWAG9408 ╒µ╩· 17 Üd {πI recently found out that you can adjust the colours regardless of whatπvideo mode you happen to be in. Play around with this program ...ππ------------------- 8< ------------------------------------π{ Simple little program to "fade" out text on the screen.ππ Feel free to play around with it ...ππ Doesn't fully work, but should give you a good idea. Note that it requiresπ a VGA (or better) graphics card. }ππUSES CRT;π πCONST π { Colour of DOS text. } π DOS_COLOUR = LIGHTGRAY; π πTYPE π PaletteType = RECORD π R, G, B : BYTE; π End; π πVAR π Colour, π ColourCnt : BYTE; π AllColours : ARRAY[ 0..63 ] OF PaletteType; π πBEGIN π FOR Colour := 0 TO 16 DO π Begin π TextColor( Colour ); π WriteLn( 'This is some text' );π End; π π { Read in all the colours of the palette into an array. } π FOR Colour := 0 TO 63 DO π Begin π { Indicate that the palette registers are going to be read } π Port[ $3C7 ] := 0; π π AllColours[ Colour ].R := Port[ $3C9 ]; π AllColours[ Colour ].G := Port[ $3C9 ]; π AllColours[ Colour ].B := Port[ $3C9 ]; π End; π π { Fade out any text that is on the screen. } π WHILE AllColours[ 61 ].B > 1 DO π FOR Colour := 0 TO 63 DO π Begin π Port[ $3C8 ] := Colour; π π IF AllColours[ Colour ].R > 0 THENπ DEC( AllColours[ Colour ].R ); π π IF AllColours[ Colour ].G > 0 THEN π DEC( AllColours[ Colour ].G ); π π IF AllColours[ Colour ].B > 0 THEN π DEC( AllColours[ Colour ].B ); π π Port[ $3C9 ] := AllColours[ Colour ].R; π Port[ $3C9 ] := AllColours[ Colour ].G; π Port[ $3C9 ] := AllColours[ Colour ].B; π π Delay( 10 ); π End; π π TextColor( DOS_COLOUR ); π π ClrScr; π WriteLn( 'Watch me fade back in ...' ); ππ FOR ColourCnt := 0 TO 42 DO π Begin π Port[ $3C8 ] := DOS_COLOUR; π π Port[ $3C9 ] := ColourCnt; π Port[ $3C9 ] := ColourCnt; π Port[ $3C9 ] := ColourCnt; π π Delay( 20 ); π End; πEND. π 10 08-24-9413:36ALL GRANT BEATTIE Fader in textmode SWAG9408 `° 16 Üd Unit FadeUnit; { called FadeUnit.Pas }ππ{ This unit does fading for text/graph modes }ππinterfaceππprocedure InitCol; { gets the current palette and saves it }πprocedure FadeOut(Duration : byte); { lowers/increases the brightness, }πprocedure FadeIn(Duration : byte); { duration determines the time it takes}πprocedure SetBrightness(Brightness : byte); { sets the brightness to brightnes}ππimplementationππuses Crt; { use Delay procedure from there }ππconstπPelIdxR = $3C7; { Port to read from }πPelIdxW = $3C8; { Port to write to }πPelData = $3C9; { Dataport }πMaxreg = 63; { Set to 255 for graphmode }πMaxInten = 63;ππtypeπTRGB = record R, G, B : byte end;ππvarπCol : array[0..MaxReg] of TRGB;πI : byte;ππProcedure GetCol(ColNr : byte; var R, G, B : byte); assembler;πAsmπMOV DX,PelIdxRπMOV AL,ColNrπOUT DX,ALπMOV DX,PelDataπLES SI,RπIN AL,DXπMOV BYTE PTR [ES:SI],ALπLES SI,GπIN AL,DXπMOV BYTE PTR [ES:SI],ALπLES SI,BπIN AL,DXπMOV BYTE PTR [ES:SI],ALπEnd; { GetCol }ππProcedure SetCol(ColNr, R, G, B : byte); assembler; { Change just one color }πAsmπMOV DX,PelIdxWπMOV AL,ColNrπOUT DX,ALπMOV DX,PelDataπMOV AL,RπOUT DX,ALπMOV AL,GπOUT DX,ALπMOV AL,BπOUT DX,ALπEnd; { SetCol }ππProcedure InitCol; { Save initial palette }πBeginπfor I := 0 to MaxReg do GetCol(I, Col[I].R, Col[I].G, Col[I].B)πEnd; { InitCol }ππProcedure SetBrightness;πBeginπfor I := 0 to MaxReg doπSetCol(I,πCol[I].R * Brightness div MaxInten,πCol[I].G * Brightness div MaxInten,πCol[I].B * Brightness div MaxInten)πEnd; { SetBrightness }ππProcedure FadeOut;πvar I : byte;πBeginπfor I := MaxInten downto 0 doπbeginπSetBrightness(I);πDelay(Duration)πendπEnd; { FadeOut }ππProcedure FadeIn;πvar I : byte;πBeginπfor I := 0 to MaxInten doπbeginπSetBrightness(I);πDelay(Duration)πendπEnd; { FadeIn }ππEnd. { FADEUNIT.PAS }π 11 08-24-9413:40ALL THIERRY DE LEEUW EGA/VGA Font Editor SWAG9408 m╫╝Θ 340 Üd π{..$define First} { disable to force loading of file }ππ{use this if you launch the program for the first time (you also may add aπcode to detect if the file already exiists but... normally, you should useπthis option once.}ππprogram GenSmallCar;π{CopyRight Thierry De Leeuw 1994}πuses crt, dos, graph;ππType TSmallCar = Array [0..8] of Byte;π PSmallCar = ^TSmallCar;ππvar SmallCar : Array[32..180] of PSmallCar;π Buffer : Array[0..7,0..8] of Char;π grDriver : Integer;π grMode : Integer;π ErrCode : Integer;π EnCours : Byte;ππProcedure ReserveMemoire;πvar i : byte;πbeginπ For i := 32 to 180 doπ beginπ New(SmallCar[i]);π end;πend;ππprocedure ChargeTable;πvar Fichier : Text;π i : byte;π j : byte;πbeginπ {$Ifndef First}π Assign(Fichier, 'Small.FON');π Reset(Fichier);π {$Endif}π For i := 32 to 180 doπ beginπ for j := 0 to 8 doπ beginπ {$IFDEF First}π SmallCar[i]^[j] := 0;π {$Else}π readLn(Fichier, SmallCar[i]^[j]);π {$Endif}π end;π {$Ifndef First}π Readln(Fichier);π {$Endif}π end;π {$Ifndef First}π Close(Fichier);π {$endif}πend;ππfunction Analyse(Valeur: byte) : String;πvar Tmp : String[19];πbeginπ Tmp := ' ';π Analyse := Tmpπππend;ππProcedure Update(No : Byte);πvar i : byte;π j : byte;ππbeginπ ClrScr;π LowVideo;π GotoXY(22,1);π Write('Edition du caractère n° ',No:3,' - "',Chr(No),'".');π GotoXY(22,2);π Write('══════════════════════════════════');π gotoXY(30,4);π Write('╔═════════════════╗');π gotoXY(30,5);π Write('║ ║');π gotoXY(30,6);π Write('║ ║');π gotoXY(30,7);π Write('║ ║');π gotoXY(30,8);π Write('║ ║');π gotoXY(30,9);π Write('║ ║');π gotoXY(30,10);π Write('║ ║');π gotoXY(30,11);π Write('║ ║');π gotoXY(30,12);π Write('║ ║');π gotoXY(30,13);π Write('║ ║');π gotoXY(30,14);π Write('╚═════════════════╝');π For i := 0 to 8 doπ beginπ gotoXY(31,5+i);π For j := 0 to 7 doπ Write(' ' + Buffer[j,i]);π end;πend;ππProcedure Bufferize(No : Byte);πvar i : byte;πbeginπ for i := 0 to 8 doπ beginπ if SmallCar[No]^[i] and 1 <> 0 then Buffer[0,i] := '*' else Buffer[0,i]π:= '·';π if SmallCar[No]^[i] and 2 <> 0 then Buffer[1,i] := '*' else Buffer[1,i]π:= '·';π if SmallCar[No]^[i] and 4 <> 0 then Buffer[2,i] := '*' else Buffer[2,i]π:= '·';π if SmallCar[No]^[i] and 8 <> 0 then Buffer[3,i] := '*' else Buffer[3,i]π:= '·';π if SmallCar[No]^[i] and 16 <> 0 then Buffer[4,i] := '*' else Buffer[4,i]π:= '·';π if SmallCar[No]^[i] and 32 <> 0 then Buffer[5,i] := '*' else Buffer[5,i]π:= '·';π if SmallCar[No]^[i] and 64 <> 0 then Buffer[6,i] := '*' else Buffer[6,i]π:= '·';π if SmallCar[No]^[i] and 128 <> 0 then Buffer[7,i] := '*' elseπBuffer[7,i] := '·';ππ end;πend;ππprocedure Encode(No : Byte);πvar i,j : byte;πbeginπ for i := 0 to 8 doπ beginπ SmallCar[No]^[i] := 0;π if Buffer[0,i] = '*' then SmallCar[No]^[i] := 1;π if Buffer[1,i] = '*' then SmallCar[No]^[i] := SmallCar[No]^[i] + 2;π if Buffer[2,i] = '*' then SmallCar[No]^[i] := SmallCar[No]^[i] + 4;π if Buffer[3,i] = '*' then SmallCar[No]^[i] := SmallCar[No]^[i] + 8;π if Buffer[4,i] = '*' then SmallCar[No]^[i] := SmallCar[No]^[i] + 16;π if Buffer[5,i] = '*' then SmallCar[No]^[i] := SmallCar[No]^[i] + 32;π if Buffer[6,i] = '*' then SmallCar[No]^[i] := SmallCar[No]^[i] + 64;π if Buffer[7,i] = '*' then SmallCar[No]^[i] := SmallCar[No]^[i] + 128;π end;πend;ππprocedure Preview;πvar i, j : byte;πbeginπ initGraph(grDriver,GrMode,'\turbo\tp\');π for i := 0 to 8 doπ beginπ for j := 0 to 7 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+GetMaxX div 2 ,i+GetMaxY divπ2,15);π end;π end;π readkey;π closeGraph;πend;ππprocedure PreviewAll;πvar i, j, k : byte;πbeginπ initGraph(grDriver,GrMode,'\turbo\tp\');π for k := 32 to 96 doπ beginπ Bufferize(k);π for i := 0 to 8 doπ beginπ for j := 0 to 7 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+(k-32) * 9 ,i+GetMaxY divπ2-10,15);π end;π end;π end;π for k := 97 to 180 doπ beginπ Bufferize(k);π for i := 0 to 8 doπ beginπ for j := 0 to 7 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+(k-97) * 9 ,i+GetMaxY divπ2+10,15);π end;π end;π end;π readkey;π closeGraph;πend;ππfunction Edit(No : byte) : Char;πvar x, y : byte;π car : Char;π Sortie : Boolean;π Go : byte;πbeginπ UpDate(No);π x := 0;π y := 0;π Sortie := false;ππ repeatπ GotoXY(32 + 2*x,5+y);π HighVideo;π Write(Buffer[x,y]);π GotoXY(32 + 2*x,5+y);π repeatπ until keypressed;π car := ReadKey;π GotoXY(32 + 2*x,5+y);π LowVideo;π Write(Buffer[x,y]);π if (car = 'q') or (car = 'Q') then car := #13;π if car = #0 then car := ReadKey;π case car ofπ '2',chr(80) : if y = 8 then y := 0 else inc(y);π '8',chr(72) : if y = 0 then y := 8 else dec(y);π '4',chr(75) : if x = 0 then x := 7 else dec(x);π '6',chr(77) : if x = 7 then x := 0 else inc(x);π ' ' : if Buffer[x,y] = '*' then Buffer[x,y] := '·' elseπBuffer[x,y] := '*';π #13, #81, #73 : Sortie := true;π #27 : Sortie := True;π 'G','g' : beginπ GotoXY(20,24);π Write('Aller à quel code ascii ? ');π Read(Go);π if (Go >= 32) and (go <= 180) thenπ beginπ Encode(No);π EnCours := Go -1;π Car := #81;π Sortie := true;π end;π GotoXY(1,24);π ClrEol;π end;ππ 'v' : beginπ Preview;π update(No);π end;π 'a' : beginπ Encode(No);π PreviewAll;π Bufferize(No);π Update(No);π end;π end;π until (sortie);π Encode(No);π Edit := Car;πend;ππprocedure EditeTable;πvar fin : boolean;π Car : char;π Car_Retour : char;πbeginπ fin := false;π Encours := 32;π repeatπ Bufferize(Encours);π Car_Retour := Edit(EnCours);π case car_Retour ofπ #13 : beginπ gotoXY(20,24);π Write('Quitter ? ');π Car := UpCase(readKey);π GotoXY(1,24);π ClrEol;π if Car = 'O' then Fin := true;π end;π #81 : beginπ if EnCours = 180 then Encours := 32 else inc(EnCours);π end;π #73 : beginπ if EnCours = 32 then Encours := 180 else dec(EnCours);π end;π #27 : beginπ gotoXY(20,24);π Write('Abandon des modifications ? ');π Car := UpCase(readKey);π GotoXY(1,24);π ClrEol;π if Car = 'O' then Halt(0);π end;π end;π until fin;πend;ππprocedure SauveTable;πvar Fichier : Text;π i : byte;π j : byte;πbeginπ Assign(Fichier, 'Small.FON');π Rewrite(Fichier);π For i := 32 to 180 doπ beginπ for j := 0 to 8 doπ beginπ writeLn(Fichier, SmallCar[i]^[j]);π end;π WriteLn(Fichier);π end;π Close(Fichier);πend;ππbeginπ DetectGraph(GrDriver, GrMode);π InitGraph(grDriver, grMode,'\turbo\tp\');π ErrCode := GraphResult;π if ErrCode <> grOk thenπ beginπ Writeln('Graphics error:', GraphErrorMsg(ErrCode));π Halt(255);π end;π CloseGraph;πππ NormVideo;π ReserveMemoire;π ChargeTable;π EditeTable;π SauveTable;πend.ππ{$define}π{same remark as above}ππprogram GenMidCar;π{CopyRight Thierry De Leeuw 1994}πuses crt, dos, graph;ππType TMidCar = Array [0..18] of Word;π PMidCar = ^TMidCar;ππvar MidCar : Array[32..180] of PMidCar;π Buffer : Array[0..15,0..18] of Char;π grDriver : Integer;π grMode : Integer;π ErrCode : Integer;π EnCours : Byte;ππProcedure ReserveMemoire;πvar i : byte;πbeginπ For i := 32 to 180 doπ beginπ New(MidCar[i]);π end;πend;ππprocedure ChargeTable;πvar Fichier : Text;π i : byte;π j : byte;πbeginπ {$Ifndef First}π Assign(Fichier, 'Mid.FON');π Reset(Fichier);π {$Endif}π For i := 32 to 180 doπ beginπ for j := 0 to 18 doπ beginπ {$IFDEF First}π MidCar[i]^[j] := 0;π {$Else}π readLn(Fichier, MidCar[i]^[j]);π {$Endif}π end;π {$Ifndef First}π Readln(Fichier);π {$Endif}π end;π {$Ifndef First}π Close(Fichier);π {$endif}πend;ππfunction Analyse(Valeur: byte) : String;πvar Tmp : String[19];πbeginπ Tmp := ' ';π Analyse := Tmpπππend;ππProcedure Update(No : Byte);πvar i : byte;π j : byte;ππbeginπ ClrScr;π LowVideo;π GotoXY(22,1);π Write('Edition du caractère n° ',No:3,' - "',Chr(No),'".');π GotoXY(22,2);π Write('══════════════════════════════════');π gotoXY(20,4);π Write('╔═════════════════════════════════╗');π gotoXY(20,5);π Write('║ ║');π gotoXY(20,6);π Write('║ ║');π gotoXY(20,7);π Write('║ ║');π gotoXY(20,8);π Write('║ ║');π gotoXY(20,9);π Write('║ ║');π gotoXY(20,10);π Write('║ ║');π gotoXY(20,11);π Write('║ ║');π gotoXY(20,12);π Write('║ ║');π gotoXY(20,13);π Write('║ ║');π gotoXY(20,14);π Write('║ ║');π gotoXY(20,15);π Write('║ ║');π gotoXY(20,16);π Write('║ ║');π gotoXY(20,17);π Write('║ ║');π gotoXY(20,18);π Write('║ ║');π gotoXY(20,19);π Write('║ ║');π gotoXY(20,20);π Write('║ ║');π gotoXY(20,21);π Write('║ ║');π gotoXY(20,22);π Write('║ ║');π gotoXY(20,23);π Write('║ ║');π gotoXY(20,24);π Write('╚═════════════════════════════════╝');π For i := 0 to 18 doπ beginπ gotoXY(21,5+i);π For j := 0 to 15 doπ Write(' ' + Buffer[j,i]);π end;πend;ππProcedure Bufferize(No : Byte);πvar i : byte;πbeginπ for i := 0 to 18 doπ beginπ if MidCar[No]^[i] and 1 <> 0 then Buffer[0,i] := '*' else Buffer[0,i] :=π'·';π if MidCar[No]^[i] and 2 <> 0 then Buffer[1,i] := '*' else Buffer[1,i] :=π'·';π if MidCar[No]^[i] and 4 <> 0 then Buffer[2,i] := '*' else Buffer[2,i] :=π'·';π if MidCar[No]^[i] and 8 <> 0 then Buffer[3,i] := '*' else Buffer[3,i] :=π'·';π if MidCar[No]^[i] and 16 <> 0 then Buffer[4,i] := '*' else Buffer[4,i]π:= '·';π if MidCar[No]^[i] and 32 <> 0 then Buffer[5,i] := '*' else Buffer[5,i]π:= '·';π if MidCar[No]^[i] and 64 <> 0 then Buffer[6,i] := '*' else Buffer[6,i]π:= '·';π if MidCar[No]^[i] and 128 <> 0 then Buffer[7,i] := '*' else Buffer[7,i]π:= '·';π if MidCar[No]^[i] and 256 <> 0 then Buffer[8,i] := '*' else Buffer[8,i]π:= '·';π if MidCar[No]^[i] and 512 <> 0 then Buffer[9,i] := '*' else Buffer[9,i]π:= '·';π if MidCar[No]^[i] and 1024 <> 0 then Buffer[10,i] := '*' elseπBuffer[10,i] := '·';π if MidCar[No]^[i] and 2048 <> 0 then Buffer[11,i] := '*' elseπBuffer[11,i] := '·';π if MidCar[No]^[i] and 4096 <> 0 then Buffer[12,i] := '*' elseπBuffer[12,i] := '·';π if MidCar[No]^[i] and 8192 <> 0 then Buffer[13,i] := '*' elseπBuffer[13,i] := '·';π if MidCar[No]^[i] and 16384 <> 0 then Buffer[14,i] := '*' elseπBuffer[14,i] := '·';π if MidCar[No]^[i] and 32768 <> 0 then Buffer[15,i] := '*' elseπBuffer[15,i] := '·';ππ end;πend;ππprocedure Encode(No : Byte);πvar i,j : byte;πbeginπ for i := 0 to 18 doπ beginπ MidCar[No]^[i] := 0;π if Buffer[0,i] = '*' then MidCar[No]^[i] := 1;π if Buffer[1,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 2;π if Buffer[2,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 4;π if Buffer[3,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 8;π if Buffer[4,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 16;π if Buffer[5,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 32;π if Buffer[6,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 64;π if Buffer[7,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 128;π if Buffer[8,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 256;π if Buffer[9,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 512;π if Buffer[10,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 1024;π if Buffer[11,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 2048;π if Buffer[12,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 4096;π if Buffer[13,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 8192;π if Buffer[14,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 16384;π if Buffer[15,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 32768;π end;πend;ππprocedure Preview;πvar i, j : byte;πbeginπ initGraph(grDriver,GrMode,'\turbo\tp\');π for i := 0 to 18 doπ beginπ for j := 0 to 15 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+GetMaxX div 2 ,i+GetMaxY divπ2,15);π end;π end;π readkey;π closeGraph;πend;ππprocedure PreviewAll;πvar i, j, k : byte;πbeginπ initGraph(grDriver,GrMode,'\turbo\tp\');π for k := 32 to 64 doπ beginπ Bufferize(k);π for i := 0 to 18 doπ beginπ for j := 0 to 15 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+(k-32) * 18 ,i+GetMaxY divπ2-20,15);π end;π end;π end;π for k := 65 to 96 doπ beginπ Bufferize(k);π for i := 0 to 18 doπ beginπ for j := 0 to 15 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+(k-65) * 18 ,i+GetMaxY divπ2+10,15);π end;π end;π end;π for k := 97 to 127 doπ beginπ Bufferize(k);π for i := 0 to 18 doπ beginπ for j := 0 to 15 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+(k-97) * 18 ,i+GetMaxY divπ2+30,15);π end;π end;π end;π for k := 128 to 155 doπ beginπ Bufferize(k);π for i := 0 to 18 doπ beginπ for j := 0 to 15 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+(k-128) * 18 ,i+GetMaxY divπ2+50,15);π end;π end;π end;π for k := 156 to 180 doπ beginπ Bufferize(k);π for i := 0 to 18 doπ beginπ for j := 0 to 15 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+(k-156) * 18 ,i+GetMaxY divπ2+70,15);π end;π end;π end;π readkey;π closeGraph;πend;ππfunction Edit(No : byte) : Char;πvar x, y : byte;π car : Char;π Sortie : Boolean;π Go : byte;π CaracTempo : char;πbeginπ UpDate(No);π x := 0;π y := 0;π Sortie := false;ππ repeatπ GotoXY(22 + 2*x,5+y);π HighVideo;π Write(Buffer[x,y]);π GotoXY(22 + 2*x,5+y);π repeatπ until keypressed;π car := ReadKey;π GotoXY(22 + 2*x,5+y);π LowVideo;π Write(Buffer[x,y]);π if (car = 'q') or (car = 'Q') then car := #13;π if car = #0 then car := ReadKey;π case car ofπ '2',chr(80) : if y = 18 then y := 0 else inc(y);π '8',chr(72) : if y = 0 then y := 18 else dec(y);π '4',chr(75) : if x = 0 then x := 15 else dec(x);π '6',chr(77) : if x = 15 then x := 0 else inc(x);π ' ' : if Buffer[x,y] = '*' then Buffer[x,y] := '·' elseπBuffer[x,y] := '*';π #13, #81, #73 : Sortie := true;π #27 : Sortie := True;π 'G','g' : beginπ GotoXY(20,24);π Write('Aller à quel code ascii ? ');π Read(Go);π if (Go >= 32) and (go <= 180) thenπ beginπ Encode(No);π EnCours := Go -1;π Car := #81;π Sortie := true;π end;π GotoXY(1,24);π ClrEol;π end;ππ 'v', 'V' : beginπ Preview;π update(No);π end;π 'a', 'A' : beginπ Encode(No);π PreviewAll;π Bufferize(No);π Update(No);π end;π 'c', 'C' : beginπ gotoXY(20,24);π Write('Copier quel caractère ? ');π CaracTempo := ReadKey;π if CaracTempo <> #13 thenπ beginπ Bufferize(ord(CaracTempo));π UpDate(EnCOurs);π end;π GotoXY(20,24);π ClrEol;π end;π end;π until (sortie);π Encode(No);π Edit := Car;πend;ππprocedure EditeTable;πvar fin : boolean;π Car : char;π Car_Retour : char;πbeginπ fin := false;π Encours := 32;π repeatπ Bufferize(Encours);π Car_Retour := Edit(EnCours);π case car_Retour ofπ #13 : beginπ gotoXY(20,24);π Write('Quitter ? ');π Car := UpCase(readKey);π GotoXY(1,24);π ClrEol;π if Car = 'O' then Fin := true;π end;π #81 : beginπ if EnCours = 180 then Encours := 32 else inc(EnCours);π end;π #73 : beginπ if EnCours = 32 then Encours := 180 else dec(EnCours);π end;π #27 : beginπ gotoXY(20,24);π Write('Abandon des modifications ? ');π Car := UpCase(readKey);π GotoXY(1,24);π ClrEol;π if Car = 'O' then Halt(0);π end;π end;π until fin;πend;ππprocedure SauveTable;πvar Fichier : Text;π i : byte;π j : byte;πbeginπ Assign(Fichier, 'Mid.FON');π Rewrite(Fichier);π For i := 32 to 180 doπ beginπ for j := 0 to 18 doπ beginπ writeLn(Fichier, MidCar[i]^[j]);π end;π WriteLn(Fichier);π end;π Close(Fichier);πend;ππbeginπ DetectGraph(GrDriver, GrMode);π InitGraph(grDriver, grMode,'\turbo\tp\');π ErrCode := GraphResult;π if ErrCode <> grOk thenπ beginπ Writeln('Graphics error:', GraphErrorMsg(ErrCode));π Halt(255);π end;π CloseGraph;πππ NormVideo;π ReserveMemoire;π ChargeTable;π EditeTable;π SauveTable;πend.ππ{$define}π{same remark as above}πprogram GenMidCar;ππ{CopyRight Thierry De Leeuw 1994}ππuses crt, dos, graph;ππType TBigCar = Array [0..36] of LongInt;π PBigCar = ^TBigCar;π TEtat = (Move, delete, trace);ππvar BigCar : Array[32..180] of PBigCar;π Buffer : Array[0..31,0..36] of Char;π grDriver : Integer;π grMode : Integer;π ErrCode : Integer;π EnCours : Byte;π Etat : TEtat;ππProcedure ReserveMemoire;πvar i : byte;πbeginπ For i := 32 to 180 doπ beginπ New(BigCar[i]);π end;πend;ππprocedure ChargeTable;πvar Fichier : Text;π i : byte;π j : byte;πbeginπ {$Ifndef First}π Assign(Fichier, 'Big.FON');π Reset(Fichier);π {$Endif}π For i := 32 to 180 doπ beginπ for j := 0 to 36 doπ beginπ {$IFDEF First}π BigCar[i]^[j] := 0;π {$Else}π readLn(Fichier, BigCar[i]^[j]);π {$Endif}π end;π {$Ifndef First}π Readln(Fichier);π {$Endif}π end;π {$Ifndef First}π Close(Fichier);π {$endif}πend;ππfunction Analyse(Valeur: byte) : String;πvar Tmp : String[19];πbeginπ Tmp := ' ';π Analyse := Tmpπend;ππProcedure Update(No : Byte);πvar i : byte;π j : byte;ππbeginπ ClrScr;π textMode(258);π LowVideo;π GotoXY(1,1);π if etat = move then write('Move')π elseπ if etat = delete then write('Delete')π elseπ if etat = trace then write('Trace');π GotoXY(22,1);π Write('Edition du caractère n° ',No:3,' - "',Chr(No),'".');π GotoXY(22,2);π Write('══════════════════════════════════');π gotoXY(2,4);πWrite('╔══════════════════════════════════════════════════════════════════╗');π gotoXY(2,5);π Write('║ ║');π gotoXY(2,6);π Write('║ ║');π gotoXY(2,7);π Write('║ ║');π gotoXY(2,8);π Write('║ ║');π gotoXY(2,9);π Write('║ ║');π gotoXY(2,10);π Write('║ ║');π gotoXY(2,11);π Write('║ ║');π gotoXY(2,12);π Write('║ ║');π gotoXY(2,13);π Write('║ ║');π gotoXY(2,14);π Write('║ ║');π gotoXY(2,15);π Write('║ ║');π gotoXY(2,16);π Write('║ ║');π gotoXY(2,17);π Write('║ ║');π gotoXY(2,18);π Write('║ ║');π gotoXY(2,19);π Write('║ ║');π gotoXY(2,20);π Write('║ ║');π gotoXY(2,21);π Write('║ ║');π gotoXY(2,22);π Write('║ ║');π gotoXY(2,23);π Write('║ ║');π gotoXY(2,24);π Write('║ ║');π gotoXY(2,25);π Write('║ ║');π gotoXY(2,26);π Write('║ ║');π gotoXY(2,27);π Write('║ ║');π gotoXY(2,28);π Write('║ ║');π gotoXY(2,29);π Write('║ ║');π gotoXY(2,30);π Write('║ ║');π gotoXY(2,31);π Write('║ ║');π gotoXY(2,32);π Write('║ ║');π gotoXY(2,33);π Write('║ ║');π gotoXY(2,34);π Write('║ ║');π gotoXY(2,35);π Write('║ ║');π gotoXY(2,36);π Write('║ ║');π gotoXY(2,37);π Write('║ ║');π gotoXY(2,38);π Write('║ ║');π gotoXY(2,39);π Write('║ ║');π gotoXY(2,40);π Write('║ ║');π gotoXY(2,41);π Write('║ ║');π gotoXY(2,42);π Write('║ ║');π gotoXY(2,43);πWrite('╚══════════════════════════════════════════════════════════════════╝');π For i := 0 to 36 doπ beginπ gotoXY(3,5+i);π For j := 0 to 31 doπ Write(' ' + Buffer[j,i]);π end;πend;ππProcedure Bufferize(No : Byte);πvar i : byte;πbeginπ for i := 0 to 36 doπ beginπ if BigCar[No]^[i] and 1 <> 0 then Buffer[0,i] := '*' else Buffer[0,i] :=π'·';π if BigCar[No]^[i] and 2 <> 0 then Buffer[1,i] := '*' else Buffer[1,i] :=π'·';π if BigCar[No]^[i] and 4 <> 0 then Buffer[2,i] := '*' else Buffer[2,i] :=π'·';π if BigCar[No]^[i] and 8 <> 0 then Buffer[3,i] := '*' else Buffer[3,i] :=π'·';π if BigCar[No]^[i] and $10 <> 0 then Buffer[4,i] := '*' else Buffer[4,i]π:= '·';π if BigCar[No]^[i] and $20 <> 0 then Buffer[5,i] := '*' else Buffer[5,i]π:= '·';π if BigCar[No]^[i] and $40 <> 0 then Buffer[6,i] := '*' else Buffer[6,i]π:= '·';π if BigCar[No]^[i] and $80 <> 0 then Buffer[7,i] := '*' else Buffer[7,i]π:= '·';π if BigCar[No]^[i] and $100 <> 0 then Buffer[8,i] := '*' else Buffer[8,i]π:= '·';π if BigCar[No]^[i] and $200 <> 0 then Buffer[9,i] := '*' else Buffer[9,i]π:= '·';π if BigCar[No]^[i] and $400 <> 0 then Buffer[10,i] := '*' elseπBuffer[10,i] := '·';π if BigCar[No]^[i] and $800 <> 0 then Buffer[11,i] := '*' elseπBuffer[11,i] := '·';π if BigCar[No]^[i] and $1000 <> 0 then Buffer[12,i] := '*' elseπBuffer[12,i] := '·';π if BigCar[No]^[i] and $2000 <> 0 then Buffer[13,i] := '*' elseπBuffer[13,i] := '·';π if BigCar[No]^[i] and $4000 <> 0 then Buffer[14,i] := '*' elseπBuffer[14,i] := '·';π if BigCar[No]^[i] and $8000 <> 0 then Buffer[15,i] := '*' elseπBuffer[15,i] := '·';π if BigCar[No]^[i] and $10000 <> 0 then Buffer[16,i] := '*' elseπBuffer[16,i] := '·';π if BigCar[No]^[i] and $20000 <> 0 then Buffer[17,i] := '*' elseπBuffer[17,i] := '·';π if BigCar[No]^[i] and $40000 <> 0 then Buffer[18,i] := '*' elseπBuffer[18,i] := '·';π if BigCar[No]^[i] and $80000 <> 0 then Buffer[19,i] := '*' elseπBuffer[19,i] := '·';π if BigCar[No]^[i] and $100000 <> 0 then Buffer[20,i] := '*' elseπBuffer[20,i] := '·';π if BigCar[No]^[i] and $200000 <> 0 then Buffer[21,i] := '*' elseπBuffer[21,i] := '·';π if BigCar[No]^[i] and $400000 <> 0 then Buffer[22,i] := '*' elseπBuffer[22,i] := '·';π if BigCar[No]^[i] and $800000 <> 0 then Buffer[23,i] := '*' elseπBuffer[23,i] := '·';π if BigCar[No]^[i] and $1000000 <> 0 then Buffer[24,i] := '*' elseπBuffer[24,i] := '·';π if BigCar[No]^[i] and $2000000 <> 0 then Buffer[25,i] := '*' elseπBuffer[25,i] := '·';π if BigCar[No]^[i] and $4000000 <> 0 then Buffer[26,i] := '*' elseπBuffer[26,i] := '·';π if BigCar[No]^[i] and $8000000 <> 0 then Buffer[27,i] := '*' elseπBuffer[27,i] := '·';π if BigCar[No]^[i] and $10000000 <> 0 then Buffer[28,i] := '*' elseπBuffer[28,i] := '·';π if BigCar[No]^[i] and $20000000 <> 0 then Buffer[29,i] := '*' elseπBuffer[29,i] := '·';π if BigCar[No]^[i] and $40000000 <> 0 then Buffer[30,i] := '*' elseπBuffer[30,i] := '·';π if BigCar[No]^[i] and $80000000 <> 0 then Buffer[31,i] := '*' elseπBuffer[31,i] := '·';ππ end;πend;ππprocedure Encode(No : Byte);πvar i,j : byte;πbeginπ for i := 0 to 36 doπ beginπ BigCar[No]^[i] := 0;π if Buffer[0,i] = '*' then BigCar[No]^[i] := 1;π if Buffer[1,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $2;π if Buffer[2,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $4;π if Buffer[3,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $8;π if Buffer[4,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $10;π if Buffer[5,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $20;π if Buffer[6,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $40;π if Buffer[7,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $80;π if Buffer[8,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $100;π if Buffer[9,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $200;π if Buffer[10,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $400;π if Buffer[11,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $800;π if Buffer[12,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $1000;π if Buffer[13,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $2000;π if Buffer[14,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $4000;π if Buffer[15,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $8000;π if Buffer[16,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $10000;π if Buffer[17,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $20000;π if Buffer[18,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $40000;π if Buffer[19,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $80000;π if Buffer[20,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $100000;π if Buffer[21,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $200000;π if Buffer[22,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $400000;π if Buffer[23,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $800000;π if Buffer[24,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $1000000;π if Buffer[25,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $2000000;π if Buffer[26,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $4000000;π if Buffer[27,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $8000000;π if Buffer[28,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $10000000;π if Buffer[29,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $20000000;π if Buffer[30,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $40000000;π if Buffer[31,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $80000000;π end;πend;ππprocedure Preview;πvar i, j : byte;πbeginπ initGraph(grDriver,GrMode,'\turbo\tp\');π for i := 0 to 36 doπ beginπ for j := 0 to 31 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+GetMaxX div 2 ,i+GetMaxY divπ2,15);π end;π end;π readkey;π closeGraph;πend;ππprocedure PreviewAll;πvar i, j, k : byte;πbeginπ initGraph(grDriver,GrMode,'\turbo\tp\');π for k := 32 to 47 doπ beginπ Bufferize(k);π for i := 0 to 36 doπ beginπ for j := 0 to 31 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+(k-32) * 36 ,i+20,15);π end;π end;π end;π for k := 48 to 96 doπ beginπ Bufferize(k);π for i := 0 to 36 doπ beginπ for j := 0 to 31 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+(k-48) * 36 ,i+60,15);π end;π end;π end;π for k := 97 to 127 doπ beginπ Bufferize(k);π for i := 0 to 36 doπ beginπ for j := 0 to 31 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+(k-97) * 36 ,i+100,15);π end;π end;π end;π for k := 128 to 155 doπ beginπ Bufferize(k);π for i := 0 to 36 doπ beginπ for j := 0 to 31 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+(k-128) * 36 ,i+140,15);π end;π end;π end;π for k := 156 to 180 doπ beginπ Bufferize(k);π for i := 0 to 36 doπ beginπ for j := 0 to 31 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+(k-156) * 36 ,i+GetMaxY divπ2+70,15);π end;π end;π end;π readkey;π closeGraph;πend;ππfunction Edit(No : byte) : Char;πvar x, y : byte;π car : Char;π Sortie : Boolean;π Go : byte;π CaracTempo : char;πbeginπ UpDate(No);π x := 0;π y := 0;π Sortie := false;π Etat := Move;ππ repeatπ GotoXY(1,1);π Write(' ');π gotoxy(1,1);π if etat = move then write('Move')π elseπ if etat = delete then write('Delete')π elseπ if etat = trace then write('Trace');π GotoXY(60,1);π write('(',x:2,' , ',y:2,')');π GotoXY(4 + 2*x,5+y);π HighVideo;π Write(Buffer[x,y]);π GotoXY(4 + 2*x,5+y);π repeatπ until keypressed;π car := ReadKey;π GotoXY(4 + 2*x,5+y);π LowVideo;π Write(Buffer[x,y]);π if (car = 'q') or (car = 'Q') then car := #13;π if car = #0 then car := ReadKey;π case car ofπ '2',chr(80) : beginπ if y = 36 then y := 0 else inc(y);π if etat = trace then buffer[x,y] := '*'π else if etat = delete then buffer[x,y] := '·';π end;π '8',chr(72) : beginπ if y = 0 then y := 36 else dec(y);π if etat = trace then buffer[x,y] := '*'π else if etat = delete then buffer[x,y] := '·';π end;π '4',chr(75) : beginπ if x = 0 then x := 31 else dec(x);π if etat = trace then buffer[x,y] := '*'π else if etat = delete then buffer[x,y] := '·';π end;π '6',chr(77) : Beginπ if x = 31 then x := 0 else inc(x);π if etat = trace then buffer[x,y] := '*'π else if etat = delete then buffer[x,y] := '·';π end;π '1',chr(80) : beginπ if y = 36 then y := 0 else inc(y);π if x = 0 then x := 31 else dec(x);π if etat = trace then buffer[x,y] := '*'π else if etat = delete then buffer[x,y] := '·';π end;π '7',chr(72) : beginπ if y = 0 then y := 36 else dec(y);π if x = 0 then x := 31 else dec(x);π if etat = trace then buffer[x,y] := '*'π else if etat = delete then buffer[x,y] := '·';π end;π '9',chr(75) : beginπ if x = 31 then x := 0 else inc(x);π if y = 0 then y := 36 else dec(y);π if etat = trace then buffer[x,y] := '*'π else if etat = delete then buffer[x,y] := '·';π end;π '3',chr(77) : Beginπ if x = 31 then x := 0 else inc(x);π if y = 36 then x := 0 else inc(y);π if etat = trace then buffer[x,y] := '*'π else if etat = delete then buffer[x,y] := '·';π end;π ' ' : if etat <> trace then etat := succ(etat) else etat :=πmove;π #13, #81, #73 : Sortie := true;π #27 : Sortie := True;π 'G','g' : beginπ GotoXY(20,49);π Write('Aller à quel code ascii ? ');π Read(Go);π if (Go >= 32) and (go <= 180) thenπ beginπ Encode(No);π EnCours := Go -1;π Car := #81;π Sortie := true;π end;π GotoXY(1,49);π ClrEol;π end;ππ 'v', 'V' : beginπ Preview;π update(No);π end;π 'a', 'A' : beginπ Encode(No);π PreviewAll;π Bufferize(No);π Update(No);π end;π 'c', 'C' : beginπ gotoXY(20,49);π Write('Copier quel caractère ? ');π CaracTempo := ReadKey;π if CaracTempo <> #13 thenπ beginπ Bufferize(ord(CaracTempo));π UpDate(EnCOurs);π end;π GotoXY(20,49);π ClrEol;π end;π end;π until (sortie);π Encode(No);π Edit := Car;πend;ππprocedure EditeTable;πvar fin : boolean;π Car : char;π Car_Retour : char;πbeginπ fin := false;π Encours := 32;π repeatπ Bufferize(Encours);π Car_Retour := Edit(EnCours);π case car_Retour ofπ #13 : beginπ gotoXY(20,49);π Write('Quitter ? ');π Car := UpCase(readKey);π GotoXY(1,49);π ClrEol;π if Car = 'O' then Fin := true;π end;π #81 : beginπ if EnCours = 180 then Encours := 32 else inc(EnCours);π etat := move;π end;π #73 : beginπ if EnCours = 32 then Encours := 180 else dec(EnCours);π etat := move;π end;π #27 : beginπ gotoXY(20,49);π Write('Abandon des modifications ? ');π Car := UpCase(readKey);π GotoXY(1,49);π ClrEol;π if Car = 'O' then Halt(0);π end;π end;π until fin;πend;ππprocedure SauveTable;πvar Fichier : Text;π i : byte;π j : byte;πbeginπ Assign(Fichier, 'Big.FON');π Rewrite(Fichier);π For i := 32 to 180 doπ beginπ for j := 0 to 36 doπ beginπ writeLn(Fichier, BigCar[i]^[j]);π end;π WriteLn(Fichier);π end;π Close(Fichier);πend;ππbeginπ DetectGraph(GrDriver, GrMode);π InitGraph(grDriver, grMode,'\turbo\tp\');π ErrCode := GraphResult;π if ErrCode <> grOk thenπ beginπ Writeln('Graphics error:', GraphErrorMsg(ErrCode));π Halt(255);π end;π CloseGraph;πππ NormVideo;π ReserveMemoire;π ChargeTable;π EditeTable;π SauveTable;πend.ππ{πYou'll find here the fonts I had already done. They are not complete. (use Aπto see all the characters) You must use XX3402 that you'll find on the Swag.πIf you make others fonts, would you please send them to me ?π}ππ{ cut this out as save as FON.XX. Use XX3402 : XX3402 d FON.XX toπ create FON.ZIP containing the FONT files need here }ππ*XX3402-004554-160794--72--90-49467---------FON.ZIP--1-OF--1πI2g1--E++++6+1lIWFn1MZsTikA++8QI+++7++++Iop-H2kiFYxCXJVhggAU0DnTaRv3449hπyIzq+c6iWiaP0Ool-70D3NDSfxrpTaJujocOlDRAA5mzXdHptmmlaDi5Z+tylkr6i6vvvSiaπmd8HXZCvtn2z3xPDHKRh2okwHDTQhs6Y2trjmNAOAQAr8lDJFaRi9mlKqsDe9tvWFvTcKw1mπa4FSF-k3XAwoJeTeCZCbH5v0aBN91NgaBHPSxRA3ARGLS35gZaxd5V2fvjgmZg8K3zAn9y4Xπ2lRMmJsFfyfMuAVUXIYet1lwc2b6EzfzeAlw7k8DX6gX0MYYAAKGH7ilpNJ3lAlKno5eJhRpπ5D46Km81627lm1m1rTKIa3l99ao9iPEkjzjIURmqxsMkmMYcX8C8Sebqj75bIdS-RvJQVqBcπr-UHVaMS-t4YI-AnTz788AFGVVdqh739nt+XG3zG7IS7oAqTpshfjV+PU7nn1eWoHgIbX+aKπSTqTZR3miIKrueyhyij4M-snAbkAu-Uit4RS3fsRyaQ8wRP7FYBRBZ-vndj+66Lce0MLO6sEπ63fIIy0B8CrZa9j3xvCjyutOlbXaEEKFoHrvcAdvJUeHS9F4Znld6-HVX2F-CAv++8HHvRjVπhNZarRQZ4vfczzKi-PWVfupVCACKlbkFD60I4a8AxFFAD5wKqu0qIUlE5+j9yHFnQbRsVi+Cπx1QJdWvHsr6y4DrGdSkEtgn9iV-XiW6KHGe9oeHeeLlEKPi6Fi6PHOtHsJ2tSyR4FEUmZ0tfπEll5fNBnhIg8VCnWQlKD8lPVCYJKcoq9U5ajQjpBKj-Wld8Jcl6orMs1cKFpe1C+pq9q+gxVπuLVcjUoIyQuFbxecthQbY10GnfFvXR03wdHnsYdUZMS0UwwDxTcx4Dh5usHPJFIE8a1gt42Dπ8r1+a+iytmEUrkB+oLxEf5dhANDdgz9P6y6KvqdYRvGqx7j3BcrzWRa03JWntOazAOzIzzGYπu278HpnJRMrOAffaWWi4gOOaQE8HBWNVxOn55MIauLj0DBfUrmyK8MQW3h0oHrq6utt7THLlπxBDFJM+dOVpRr+7BoL21tI-CBrE7RpvNPB-YppDpLA8YOZYqhRpm6j--MkxJA+mHAWScBD1-πjenfvle7TFakv6Aa4zqDfFVsv41EizHCN8aiqgg0ptXcKXCCeOTeIT0IWejm6fDPANOD8CTVπDRQXSIVPeq3gwJ6RqNoC3vMY-rHxyX+KHHpEoKQqr5IZLJHW7vybdVOT44RD9TOrSCxtw9wBπYETwfIUFujjJD+gbUZBdEChACGCiDp-9+kEI++++0++JUMoQbzQ8qa+5++-FC+++-k+++2p7πF0t4HovJKyhmvGc6zhyNjcire5by7ng-j60L74NZRQyNOP-B6WX07q0eTbySzTnyu1qurlybπT83F-mwdTofjlxobEbnkptsJSzbskxbRpANM0nmAUPSpBaj1hhec8yernKuZySkhcYQ92n78πcqvURyq0Wn+R5sv4vWcF-nAmmc3mh3Ts6f+kPjSW0OMk6Mv25EIVkFZP2o09PhTFEnSj3SfEπ59qx-VtK6OQBh-dwH7opu-dvFZExXWEsEspqp4VwNYBGvUTaJ+o1lv0V3XOzm+F5vPJnSJdqπkwbUt5G+dwUSGFJNtG8V3uYHAG-al7W256c-RGPxu8EgB2dwXgH-kofe+rkDHFxukXBYZRSgπ9C5F9NNJ1Zs-7lJJKKgHT4rc5XqbRpB5sZ8t6a29pXldWDMKC8Paz3qq3jTLfGe6b+FKLNhsπlcEAbiWdFOkOcg+b6N0kls+aiM4RyUpOUw43ZKBWO71+F8DpYTpuI9HTUP3rk0DFPMCb-fVvπMz3rJTcG5sM-KJOmtdpQ3zFu94INyGQo2ikXnR9G+1kAoWcQ8UuDR9OYCSCuVOM7gSr07szrπOWVWXqInsGsg8TJ3TqKPHuCyaF8H8UZZT4COuyfXjEqvRX6MFnh8cwwFrInKD+SA9AMd45NYπIyT026hI9-i9BZOPKkrTxYRHmfO+WuvOrOSpW0aVmQUdQTHXMbd8vxltQuv+dx8S9JQ9H9TEπeoD-FFPxDYnyg6W-3C0Nx6XqJxdNaIAadV7n9u5yt32OOhqW9sNl0wPbWpyw+8QVanBBhHhbπ2vmFWC82GbKBpHUlNmWY36opV2Q64bhA0WaLhy0fFyCNtb4d8GV5Z9D7YjSdslQqq3l1V3mWπGtUdHZ3ccz2V0gK0M8qsaeX6DWrywSgIspMawvGNHoWeDlf2FHtwr16GPON3PogCvr5bZyGOπoVcmj-Dpuwp4pYmg1mBttBUuzqoZftfkaI5nfSZw2vivisbpcC0M4fu-9ZAK9St1tF2gMoBVπ7gIRSUAcW9+yawcYob9hdYEbFbJQIhCcuwFeFhQBaoq9Yuc3aoDUQqWXqVdAWkvpLI16wffLπNnFLFs8GGO4KhA4ci2ULXIKcpnNWcaVhWcQ6nmbv5iDb1B+yVdkNmd4vQmkS-Xpl5FXi-pILπ33Ab5YUpgQmBST+Ns3eaaU0gVAlfKbdrUR03T7qpPOCVohlPZkmc0F9r64cOuyElb9tbOizkπdyW36Va8OX1+YRKZRyEZLmOIGNWH2QWm4Ce4qAac8vYNcBqTcN0sZn-trJGOzREEueqZ1FR+πvnRomhEwr4V5F18ayFmDXXh9yMFkNCCqE1JMGDCUKdQXvUoee2VSb27ZaidcK3i9kfpiZpFLπSrG3wItB5sxV08Y0APo3FQg6Isi6wJU2qvbz82OaM5stB2kFgolBFvB97OTHM3UCTEGIOd7vπrZ56yHHCZ0JnwLYAnNIVtpCDWXfacYFZ+2ZrHpSBCzARThKbwz4Ou+DHlxbeWWltcaCi8lfkπqyMYaatSPFKVph7jY25ofqF-fUVdvexEZ3GCF8fBpWjUgEISAS1iH-3n7jUbDg-LM3DBhDRVπSEWnHb11DfLqsDXiZ4DrlSP8btXtjKIdRnpq+S4ewts8GQ-XzOn7vVBG+A0jR6MuMxzLZXbBπJQ9UtkJMABAdEBQHJYdfNwbAo75YODqkw759T5s+szVG5m5bxVsatgjeic4IIsvtS-z5kKEPπJcJn41sDTTg+y1lsTn7sYM7jm1HgR4kDhwtLYm7IAZzOcOkVnFeJEo7WVfTd3NozLx0bTjBIπtxp4hPDu5JfFI7csscJSBMH34G+WIjp3RIT0H2hdMyoRP3O5Gjg1bOily9abDQwYvBLMSIEUπSKgClldwceF3pSm3Lm8GErNlcqr1s8Zy0CIISCbbs8WXqksVpgC56zzcfxwDuietqVJRZ01LπbESCzS8dfpn1J7CJjVvXhiQgLwtgt3vvHK51NCwvcUVVAOQaaWJyAo3QmRqcKdWhb4RjPSZXπNV1TG8l49jGWY3aqzzswq+QMvyExkq97dolZcSU3bWYucb5yoIbhqBIK1cijNPTG8jX8ngodπtCE2wjeQuBbDdpr5PjupJ4nJptw94vfxRoGBRTWB84+seKw6SWqmiNw3XCGxQNcsCQptNrdfπloSeeMvNyhrUSg4pGkcy+s9zJxQqLjZqi1cKxwaiCKPt5MmOmbcRCfE7W2ts64pX4r+lF5UcπKQf0+nx35tAbRqgzS1Xtoi5V7ktDPLOO5Z0pMMoDkzzF+OWRT1DMO9FKWiVoUoMmYTnd2SS2πvGR5Xe9udG9zG+xfDCXny7Ju85o0famA0jyr-SgqJDZFuKFU3ddRG5+FDlDN6+9Mw-oLe1N3πyk2KJ7n4TtbEGWvdxLwReSNXq4TzvREdLlgg2uJecOOeZpTZJACLqvZO8AwW7atlrbgWfERtπyhXZI0-coOBPzwKhMqn-iTrrNvQS10A4Q7szj+TTsSVUXw5t06tVcc7zZjffarxEm3nuSi07πUDw+I2g1--E++++6+AloXVlDpuzgVkI++DBH+++5++++EYZ59YNDHipNuqsXCkXyLubjkgI4πyzaTv-XkX4SmiPFdYxoX6OK-n6IDA4-AsTDXbNzD1mFePL-I4tHqyJ47eA0W02JfdKSNGr4rπu+NzWqtevdzGoSFzLSpPW3DEkGKAdLM0SAFFFJ4K2nSchh-UtlerXaEuMmxJLfCChGa-Eba4πEp1KUcrUOzlDgBv9jRCmnkyWnWe9WW6otQ2V3o6J4MyFhA8pY9r9oVFO5kwIuPqXDp0+KeDaπ2GNBd68GmlGIfpD5PdsuUKocUQqRBalhdUMATKefwVfKh+yqksvKdNrgDrXZs8jZk2jLPjGEπ+ppUmd48t5uIKgZnL9d8EElB43gh7P7KU1pCe1M4x2KXXiCpaSZ8JbLEe3Uium1gBngHSgPrπ6QESuYB0qGeHeH9SxURauF6gRdh-DSeepkgJiwLB8oOr4khTlawdrQCbYcUf5SloZ93FRc8ZπBhw0iqyG9ifBSrSLokNnWvfPRW8pqb7DkeEK7mVgQTc8tIFJmTCagk0O+lT5J030SEL+jisvπgurvFjw6pFY5SnlUYRNyXpv8jwGzp0x0y7cZ-mhrmuztNLbBZb3Qw-Hq9zP2bj2Q6Hv71Dx7πjaj2fx25Wr4VtQa0g0cgL-Ov+usMw6+mBk08AZZpL+9PGvd6wQ958CWZVp4VxB0WPko3cfeEπUdrx8M7SAHOwIcdRWRcO3TQFivyoWxY3vp+9TKaoh3mO9qiKVRzpnIMDeTegW4zHq6T8ZxVrπuHHdKufsfQG7PKvFQsJy+aRhy+zN7wlseMiSKuRdY0K2hmOAheZtOo7lVf5KF06F8oeRtkUOπH7kTpcPyRpcHHzfE9nGnnDTwzjlcpzrTS+-saFGp5hHfEeoZBbhfRQ0XOaVA09vJaVCuq+tpπNeKnOs5IJL1ePrpWl0KdxWfFKIUPTu4W1+jN1s6o-044-+4RdNpe9sJw0lWghMjHtlpVQrxhπd-Gg+BCwKaNNhhNFcYwlRWu9gP50nW9uAS+q0x4RBXJ5mB39mrCvAzTmT5Pqjhs2JdZhNI08πxosoffiCUqbF8ECd-kDq9bvOkBuUcCSuqW5N-PPMwHT7zmC4iFO75Sg8RzMQEFQrp1mfRXsmπLoTQK9A1PPO14Xo+ZdaRpVGVrnpnZmrHTKuZAnAkc1Tu3hbC1HqeklNgsa40I8Gu023D1zhZπhcjjhx4WFAvSzptFRdyvW1C9G1EjqFCFZLtIWomAwlhgKE0+gdKliVqqe3Bddy9q91jY2zgqπ6EcxwbSclH5RKRmuSrXZ3z+jqMBRRFohkkT9AwhRmsL9fFTiXV6zaAOnLDssoKRzqtJpvVFxπVcIx2cl4+FlMRRhBcanvOA51vWvrpemLMMSXbborFknh8qntnhT-nAjNXVz1EutsUow+bLo+πQxXWLw1KTQ+VJLQoLRpyH5fL2CVeE3s25lRgNNyhMDRdZ6YHobpwledaRCRSapO9kkOJiQKaπBVtiseAavLmcHrOZalsyt6Vuiby3Pac01XrrMKGonSow6E-2a5ogyptyuT1ElKT5fU5RTQvrπVV-ZRI-hHzdtezRDY4gC+PUmgHkgzHN1N7jRkPjNUnc57KzcypsZZrSi8vbQywTVtBzmz+PQπHXLUlVHvdTKohDpIJdTlTivxWPjj12ArydDDBqLzCsdRbEGTFw0TVktonarbGTZuCzqSor5kπqtEk5hgaWBizJuTA1KD1L8SJHOpRoQAoRfTbQ5XMvJuyi9OUlwzOsyxnxtTlRuEQ0vyTB8oBπg7mDErKQHZvcrFQDGIePBdZlXxPZNTxvGQ+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2πHA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+T+js5I2g-π+VE+3+++++U+D3G75ABWLVyv+k++dlE+++Y++++++++++E+U+++++++++3BBEIlA9YNDHZ-9π+E6I+-E++++6+-K-XFmTxkfOM+Q++32s+++5++++++++++2+6++++C61++-BGIEiFYxCI2g-π+VE+3+++++U+n5GC52zLfym5-E++wpA+++Q++++++++++E+U++++Nkg++277Fmt4HotEGkI4π++++++A++k0V++++2l2+++++π***** END OF BLOCK 1 *****π 12 08-24-9413:49ALL RODNEY JOHNSON VGA Palette Code SWAG9408 hΣ3 9 Üd π{ Here is the VGA palette changing code. }ππUnit PalChg;πInterfaceπUSES DOS;πTypeπ TPalette16 = array[0..15] of array[0..2] of Byte;π TPalette256 = array[0..255] of array[0..2] of Byte;πprocedure SetVGAPalette16(PalBuf : TPalette16);πprocedure SetVGAPalette256(PalBuf : TPalette256);πImplementationπprocedure SetVGAPalette16(PalBuf : TPalette16);πvarπ Reg:Registers;πbeginπ reg.ax:=$1012; {Code for chg. palette}π reg.bx:=0; {start with color 0}π reg.cx:=16; {change 16 colors}π reg.es:=Seg(PalBuf); {address: segment}π reg.dx:=Ofs(PalBuf); {address: offset}π intr($10, reg); {interrupt call}πend;πprocedure SetVGAPalette256(PalBuf : TPalette256);πvarπ Reg: Registers;πbeginπ reg.ax:=$1012; {code for chg. palette}π reg.bx:=0; {start with color 0}π reg.cx:=256; {change 256 colors}π reg.es:=Seg(PalBuf); {address: segment}π reg.dx:=Ofs(PalBuf); {address: offset}π intr($10, reg); {interrupt call}πend;πEnd.π 13 08-24-9413:55ALL IAN LIN Text in mode 13h? SWAG9408 ½xτ 15 Üd π{ When you change modes, you lose the contents of the screenπ(cleared). It's all IBM's fault. You see, there is also a change inπresolution and available colors and how video is used. It totally changesπand that's a way of life on the PC. Sorry, no way around it but to useπfull graphics mode.ππ FA> use, of course...) (I can't do it on a IBM, but ask me for C64-sources,π FA> if you want to have a look <grin>)ππ320 x 200 x 256c, 13h, isn't the same as the resolution required for 80x50πtext (640 x 400 x 256). In that case, I have seen graphics (simple) underπtext in text mode. If you're forced to change resolution, kiss it all goodπbye.ππRun this under text: }ππ{$A+,B-,E-,F-,G+,I-,L-,N-,O-,R-,S-,V-,X-}ππprogram RedBar;ππVARπ C:Byte;π C2,C3,C4:Word;π SINTAB:Array[0..127] of Word;π HeadPtr:Word absolute $40:$1A;π TailPtr:Word absolute $40:$1C;ππbegin;π for c:=0 to 127 doπ sintab[c]:=Trunc((Sin((2*Pi/128)*C)+1)*135);π C3:=0;π REPEATπ INLINE($FA);ππ repeat until (port[$3da] and 8)>0;π repeat until (port[$3da] and 8)=0;π for c4:=0 to sintab[c3 and 127] do beginπ repeat until (port[$3da] and 1)=0;π repeat until (port[$3da] and 1)>0;π end;π for c:=0 to 63 do beginπ repeat until (port[$3da] and 1)>0;π Port[$3C8]:=0;π Port[$3C9]:=C;π Port[$3C9]:=0;π Port[$3C9]:=0;π repeat until (port[$3Da] and 1)=0;π end;ππ for c:=63 downto 0 do begin;π repeat until (port[$3Da] and 1)>0;π Port[$3C8]:=0;π Port[$3C9]:=C;π Port[$3C9]:=0;π Port[$3C9]:=0;π Repeat until (port[$3da] and 1)=0;π end;ππ port[$3C8]:=0;π port[$3c9]:=0;port[$3c9]:=0;Port[$3c9]:=0;π Inc(C3);π inline($FB);π until headptr<>tailptr;π headptr:=tailptr;πend.π 14 08-24-9413:57ALL BAS VAN GAALEN smooth text scroll SWAG9408 îΦa¼ 16 Üd {πHere's a demo for a REAL smooth textscroll. Reset lines to something usefull,πcut the sideborders, place some readable text, and your scroller is ready! ;-)ππ}πprogram smoothtextscroll;π{ by Bas van Gaalen and Sven van Heel, Holland, PD }πuses crt;πconst vidseg:word=$b800; lines=23;πvar ofs:byte;ππprocedure vertrace; assembler; asmπ mov dx,03dah; @vert1: in al,dx; test al,8; jnz @vert1π @vert2: in al,dx; test al,8; jz @vert2; end;ππprocedure setaddress(ad:word); assembler; asmπ mov dx,3d4h; mov al,0ch; mov ah,[byte(ad)+1]; out dx,axπ mov al,0dh; mov ah,[byte(ad)]; out dx,ax; end;ππprocedure setsmooth(smt:byte); assembler; asmπ mov dx,03c0h; mov al,13h+32; out dx,al; inc dx; in al,dxπ and al,11110000b; mov ah,smt; or al,ah; dec dx; out dx,al; end;ππprocedure setup(ad:word); assembler;πasmπ mov dx,3d4hπ mov al,18hπ mov ah,[byte(ad)]π out dx,axπ mov al,7π out dx,alπ inc dxπ in al,dxπ dec dxπ mov ah,[byte(ad)+1]π and ah,00000001bπ shl ah,4π and al,11101111bπ or al,ahπ mov ah,alπ mov al,7π out dx,axππ mov al,9π out dx,alπ inc dxπ in al,dxπ dec dxπ mov ah,[byte(ad)+1]π and ah,00000010bπ shl ah,5π and al,10111111bπ or al,ahπ mov ah,alπ mov al,9π out dx,axππ mov dx,03c0hπ mov al,10h+32π out dx,alπ inc dxπ in al,dxπ and al,11011111bπ or al,00100000bπ dec dxπ out dx,alπend;ππvar x,y,i:word; cx:byte;πbeginπ setup(lines*16);π setaddress((25-lines)*80);π gotoxy(1,1);π writeln('Hey, a smooth textscroll...');π x:=0; cx:=0;π randomize;π repeatπ vertrace;π setsmooth(x); ofs:=ofs mod 4;π x:=(1+x) mod 9; if x=0 then beginπ for y:=0 to lines-1 do beginπ move(mem[$b800:160*(25-lines+y)+4],mem[$b800:160*(25-lines+y)+2],158);π mem[$b800:(25-lines+y)*160+158]:=random(26)+32;π end;π end;π until keypressed;π textmode(lastmode);πend.π 15 08-24-9413:57ALL NICK BATALAS SNOW SCREEN SAVER SWAG9408 IcÅ 27 Üd π{Hello All! I've recently coded this screen saver.It really looks like snowπis falling all over, don't you think?πHowever, I did not set out to do a snow screen saver and if you experimentπwith it a little you will see that it can even turn out to be a firework!πIf anyone can improve this code or make anything out of it, I would beπvery pleased to have a copy of the source.πPlease, excuse my English.I haven't practised it for a long time.}ππPROGRAM SnowScreenSaver; {Nick Batalas 14-6-1994}πUSES crt,dos;πconstπ dots =100; {Set this to more than 100 and the result is awful}ππvarπ j,k : integer; {loop variables}π i : longint;π x,y : array[1..dots] of integer;π cols : array[1..dots] of byte;π f,g : word;ππ{--------------Procedures Needed For This Great Screen Saver------------}πPROCEDURE SetVideoMode(mode : byte);assembler;π ASMπ mov AH,0π mov AL,modeπ int 10hπ END;ππPROCEDURE writeDACreg(color,red,green,blue : byte);π BEGINπ port[$03C8]:=color;π port[$03C9]:=red;π port[$03C9]:=green;π port[$03C9]:=blue;π END;ππPROCEDURE SetBordColB(color : byte); Assembler;π ASMπ mov AH,10hπ mov AL,01hπ mov BH,colorπ int 10hπ END;ππPROCEDURE PutPixel1(x, y : word; color : byte);π BEGINπ mem[$A000:x+y*320] := color;π END;ππPROCEDURE HideTextCursor;π VARπ regs : registers;ππ BEGINπ regs.ah:= 1;π regs.cx:=$2000;π intr($10,regs);π END;ππProcedure WaitrBest;Assembler;π ASMπ cliπ mov dx,3DAhπ @l1:π in al,dxπ and al,08hπ jnz @l1π @l2:π in al,dxπ and al,08hπ jz @l2π stiπ END;ππFUNCTION xf3(ux,t : real) : word; {Calculates the speed of a point}π BEGIN {on the x axis}π xf3 := round(ux*t) +160;π END;ππFUNCTION yf3(uy,g,t : real) : word; {Calculates the speed of a point}π VAR {on the y axis (which is affected}π u,tmax,hmax : real; {by gravity)}π ym : array[1..200] of word;π a : word;π BEGINπ u := uy-g*t;π a:= round(uy*t-1/2*g*t*t);π yf3 := 200-a ;π END;ππFunction RandomCol :byte; {Just a random value between 7 and 15 (I think)}π BEGINπ randomcol:=random(6)+9;π END;ππ{-------------------------------MAIN PROGRAMME-------------------------}πBEGINπ hideTextCursor;π j:=-50; {calculate the values of the speed of each dot}π for k:=1 to dots do begin {with this loop}π j:=j+3;π x[k]:=j;π y[k]:=random(150);π END;π For i:=1 to dots do {Calculate the color of each dot}π cols[i]:= randomcol;π SetVideoMode($13);π For i:= 1 to 63 doπ writedacreg(15,i,i,i);π writedacreg(7,15,15,15); {modify color registers in order}π writedacreg(8,20,20,20); {to give a sense of depth to the}π writedacreg(9,25,25,25); {dots}π writedacreg(10,30,30,30);π writedacreg(11,35,35,35);π writedacreg(12,40,40,40);π writedacreg(13,45,45,45);π writedacreg(14,50,50,50);π For i:=1 to 5 do {the background color turns to dark blue}π writedacreg(0,0,0,i);π setbordcolb(0);π i:=18500;π j:=1;π Repeatπ i:=i+1;π FOR k:=1 to dots doπ putpixel1(xf3(x[k],0.01*i),yf3(y[k],j,0.01*i),cols[k]);π waitrbest;π FOR k:=1 to dots doπ putpixel1(xf3(x[k],0.01*i),yf3(y[k],j,0.01*i),0);π Until keypressed;π SetVideoMode(3);ππEND.π 16 08-24-9413:57ALL ERIC COOLMAN Snow Screen Saver SWAG9408 *┤╢+ 25 Üd {πNB>{Hello All! I've recently coded this screen saver.It really looks likeπNB>snow is falling all over, don't you think?ππYeah, it looked pretty neat!ππNB>However, I did not set out to do a snow screen saver and if you expπNB>with it a little you will see that it can even turn out to be a firπNB>If anyone can improve this code or make anything out of it, I wouldπNB>very pleased to have a copy of the source.ππOk, I played around with it a bit today, and following is my modifiedπversion. I pretty much just cleaned it up, got rid of all the unusedπvariables and stuff (there were quite a few <G>) for readability,πsimplified a the calculations, and removed a lot of the overhead, andπremoved most of the global variables. You will see that now you canπhave a lot more snowflakes without it bogging out. I also removed theπcustom palette because you can get pretty much the same colours usingπthe default palette (indexes 19-31). It can probably be simplifiedπeven further (ie. remove the x and y tables and just use newPos table).πOh yeah, I threw in a little snowflake explosion at the start too :-).ππ(********************************************************************π Originally by : Nick Batalas, 14-6-1994π Modifications by : Eric Coolman, 19-6-1994π********************************************************************)π}ππProgram SnowFall;πUses crt; { for keypressed only }ππconstπ Flakes = 500; { try less flakes for faster snowfall }ππ{---------------- Stuff not specific to snowfall ----------------}πProcedure vidMode(mode : byte);assembler;π asm mov ah,$00; mov al,mode; int 10h; end;ππProcedure setPixel(pixPos : word; color : byte);πbeginπ mem[$A000:pixPos] := color;πend;ππ{---------------------------MAIN PROGRAM-------------------------}ππvarπ CurFlake : integer; { snowflake counter }π i : longint; { to add velocity to flakes }π x,y, newPos: array[0..Flakes] of word; { lookup tables }πBEGINπ randomize;π for curFlake:=0 to Flakes do { set up snow lookup table }π beginπ x[curFlake]:=random(319);π y[curFlake]:=random(199);π end;ππ vidMode($13); { 320x200x256 graphics mode }ππ i := 0; { change to 100 or higher to get rid of start explosion }ππ repeatπ inc(i);ππ for curFlake:=0 to Flakes doπ beginπ setPixel(newPos[curFlake], 0); { erase old snowflake }π newPos[curFlake] := { set up and draw new snowflake }π round(x[curFlake]*(i*0.01)) + { new X }π round(y[curFlake]*(i*0.01)) * 320; { new Y }π setPixel(newPos[curFlake], (curFlake mod 13) + 19);π end;ππ while (port[$3da] and $08) = $08 do; { wait for vRetrace to }π while (port[$3da] and $08) = $00 do; { start and end }π until keypressed;ππ vidMode($03); { return to 80x25 textmode }πend.ππ 17 08-24-9414:00ALL BAS VAN GAALEN Fading Textscreen SWAG9408 ïy / 15 Üd {π AK> howdie, nice fader! i was wandering if you would be ableπ AK> to comment the program and repost it. i.e what the portsπ AK> are etc for us less experienced programmers...ππOkay, if you don't quote so much next time.ππ}ππprogram copper;π{ bar-fade in, copper v7.0, by Bas van Gaalen, Holland, PD }πuses crt;πconst size=20; { number of text-lines }πvar pal:array[0..3*size-1] of byte;ππ{ increase first value in the pal-array (the one representing red), and scrollπthat in the array }πprocedure incbars;πvar i:word;πbeginπ if pal[0]<63 then inc(pal[0]);π for i:=3*size-2 downto 0 do pal[i+1]:=pal[i];πend;ππprocedure copperbars;πvar cc,l,j:word;πbeginπ asm cli end;π while (port[$3da] and 8)<>0 do; { vertical retrace }π while (port[$3da] and 8)=0 do;π cc:=0;π for l:=0 to size-1 do beginπ port[$3c8]:=1; { set pal-idx number (1=blue) }π port[$3c9]:=pal[cc]; { set first two pal-value's (red and green }π port[$3c9]:=pal[cc+1]; { intensities }π for j:=0 to 15 do begin { 16 vertical retraces = one text line }π while (port[$3da] and 1)<>0 do;π while (port[$3da] and 1)=0 do;π end;π port[$3c9]:=pal[cc+2]; { set last pal-value (blue), and thus activateπ new palette }π inc(cc,3);π end;π asm sti end;πend;ππvar i:byte;πbeginπ textmode(co80); { 25 lines mode }π fillchar(pal,sizeof(pal),0); { clear palette array }π copperbars; { default = black -> otherwise flash of blue will appear }π textcolor(1); { set text to blue (now black, 'cos pal changed) }π writeln;π writeln('Is this what you mean?'); writeln;π for i:=1 to 15 do writeln('Test line ',i);π repeatπ incbars;π copperbars;π until keypressed; { do stuff until keypressed... }π textmode(lastmode); { back to last mode }πend.ππ 18 08-24-9417:52ALL PAUL KAHLER 32x32 Bitmap Tiles SWAG9408 6jà: 43 Üd π{$A+,B-,D+,E+,F-,G+,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V-,X+,Y+}π{$M 16384,0,655360}πProgram Tiles; { by Paul H. Kahler 1994 }πUSES CRT; {email: phkahler@oakland.edu}ππ{ This program is mostly undocumented. If you want to know whats going on,π see the other program, it has more comments and much of the same code, soπ it should be more helpful. This version doesn't account for the non-squareπ pixels in mode 13h (see the other program to fix that) and it's slowerπ because a different fixed-point format is used (see the hloop of bothπ programs). I like it because it's shorter and simpler. }ππ{ A 32x32 bitmap is defined in the data below. Feel free to change it toπ whatever you like, I just punched in the first thing that came to mind. }ππConst Tile: array [0..1023] of byte =π ( 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,π 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,1,1,1,1,1,0,0,1,1,1,0,0,1,0,0,0,1,0,1,0,0,0,0,0,0,0,0,π 2,0,0,0,0,1,0,0,0,1,0,1,0,0,0,1,0,1,0,0,0,1,0,1,0,0,0,0,0,0,0,0,π 2,0,0,0,0,1,0,0,0,1,0,1,0,0,0,1,0,1,0,0,0,1,0,1,0,0,0,0,0,0,0,0,π 2,0,0,0,0,1,1,1,1,1,0,1,1,1,1,1,0,1,0,0,0,1,0,1,0,0,0,0,0,0,0,0,π 2,0,0,0,0,1,0,0,0,0,0,1,0,0,0,1,0,1,0,0,0,1,0,1,0,0,0,0,0,0,0,0,π 2,0,0,0,0,1,0,0,0,0,0,1,0,0,0,1,0,1,0,0,0,1,0,1,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,1,1,1,0,0,1,1,1,1,1,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,5,5,5,5,5,0,0,5,5,5,5,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,5,0,0,0,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,5,0,0,0,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,5,0,0,0,0,5,5,5,0,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,5,0,0,0,0,0,0,0,5,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,5,0,0,0,0,0,0,0,5,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,5,5,5,5,5,0,5,5,5,5,0,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,3,3,3,3,0,0,3,3,3,0,0,0,3,3,3,0,0,3,0,0,0,0,0,0,0,0,π 2,0,0,0,0,3,0,0,0,0,0,3,0,0,0,3,0,3,0,0,0,3,0,3,0,0,0,0,0,0,0,0,π 2,0,0,0,0,3,0,0,0,0,0,3,0,0,0,3,0,3,0,0,0,3,0,3,0,0,0,0,0,0,0,0,π 2,0,0,0,0,3,0,0,0,0,0,3,0,0,0,3,0,3,0,0,0,3,0,3,0,0,0,0,0,0,0,0,π 2,0,0,0,0,3,0,0,0,0,0,3,0,0,0,3,0,3,0,0,0,3,0,3,0,0,0,0,0,0,0,0,π 2,0,0,0,0,3,0,0,0,0,0,3,0,0,0,3,0,3,0,0,0,3,0,3,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,3,3,3,3,0,0,3,3,3,0,0,0,3,3,3,0,0,3,3,3,3,3,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 );ππVar SinTable,CosTable: Array[0..255] of longint;ππProcedure MakeTables;πVar direction:integer;π angle:real;πbeginπ For Direction:=0 to 255 do beginπ angle:=Direction;π angle:=angle*3.14159265/128;π SinTable[Direction]:=round(Sin(angle)*256);π CosTable[Direction]:=round(Cos(angle)*256);π end;πend;ππProcedure GraphMode; {set 320x200x256 mode}πbeginπ Asmπ Mov AH,00π Mov AL,13hπ Int 10hπ end;πend;ππProcedure DrawScreen(x,y:word; rot,scale:byte);πvar Temp:Longint;π ddx,ddy,d2x,d2y:word;π i,j:word;π label hloop,vloop;ππbeginπ Temp:=(CosTable[rot]);Temp:=(Temp*Scale) div 32;π ddx:=Temp;π Temp:=(SinTable[rot]);Temp:=(Temp*Scale) div 256;π ddy:=Temp;π Temp:=(CosTable[(rot+64) and 255]);Temp:=(Temp*SCALE) div 32;π d2x:=Temp;π Temp:=(SinTable[(rot+64) and 255]);Temp:=(Temp*SCALE) div 256;π d2y:=Temp;π i:=x-ddx*160-d2x*100; j:=y-ddy*160-d2y*100;ππ ASMπ mov ax,0π mov di,axπ mov ax,$a000π mov es,axπ mov cx,200π vloop:π push cxπ mov ax,[i]π mov dx,[j]π mov cx,320π hloop:π add ax,[ddx]π add dx,[ddy]π mov bl,ahπ mov bh,dhπ shr bx,3π and bx,$03FFπ add bx,OFFSET tileπ mov si,bxπ movsbπ loop hloopππ mov ax,d2xπ add i,axπ mov ax,d2yπ add j,axπ pop cxπ loop vloopπ end;πend;ππVar dist,dd,rot,dr:byte;π x,y:word;πBeginπ MakeTables;π GraphMode;π x:=32768; y:=1024;π rot:=0; dr:=1;π dist:=127; dd:=255;π repeatπ DrawScreen(x,y,rot,dist);π rot:=rot+dr;π y:=y+128;π dist:=dist+dd;π if (dist=250) or (dist=3) then dd:=-dd;π if random(150)=3 then beginπ dr:=0; while dr=0 do dr:=random(5)-3; end;π until keypressed;π ASM {back to 80x25}π MOV AX,3π INT 10hπ END;πend. 19 08-24-9417:53ALL DAVID DAHL Palette Fades/TransparentSWAG9408 4e⌐╪ 118 Üd Program Transparent;π{ }π{ Example of How Transparency Works }π{ }π{ Programmed by David Dahl @ 1:272/38 }π{ }π{ This program is PUBLIC DOMAIN }π{ }πUses CRT, Palette;ππType ImageArray = Array [0..15, 0..15] of Byte;ππ LocationRec = Recordπ X : Integer;π Y : Integer;π End;ππ VGABufferArray = Array[0..199, 0..319] of Byte;π VGABufferPtr = ^VGABufferArray;ππConst BobTemplate : ImageArray =π ((00,00,00,00,00,00,07,07,07,07,00,00,00,00,00,00),π (00,00,00,00,07,07,04,04,04,04,06,05,00,00,00,00),π (00,00,00,07,04,04,04,04,04,04,04,04,04,00,00,00),π (00,00,07,04,04,04,04,04,04,04,04,04,04,03,00,00),π (00,07,04,04,04,04,04,04,04,04,04,04,04,04,02,00),π (00,07,04,04,04,04,04,04,04,04,04,04,04,04,01,00),π (07,04,04,04,04,04,04,04,04,04,04,04,04,04,04,01),π (07,04,04,04,04,04,04,04,04,04,04,04,04,04,04,01),π (07,04,04,04,04,04,04,04,04,04,04,04,04,04,04,01),π (07,04,04,04,04,04,04,04,04,04,04,04,04,04,04,01),π (00,06,04,04,04,04,04,04,04,04,04,04,04,04,01,00),π (00,06,04,04,04,04,04,04,04,04,04,04,04,04,01,00),π (00,00,05,04,04,04,04,04,04,04,04,04,04,01,00,00),π (00,00,00,04,04,04,04,04,04,04,04,04,01,00,00,00),π (00,00,00,00,03,02,04,04,04,04,01,01,00,00,00,00),π (00,00,00,00,00,00,01,01,01,01,00,00,00,00,00,00));ππ MaxBob = 2; { 3 Bobs (0 .. 2) }ππVar VGA : VGABufferPtr;π BackGround : VGABufferPtr;π WorkPage : VGABufferPtr;ππ Pal : PaletteArray;ππ BobImage : Array[0..MaxBob] of ImageArray;π BobLocation : Array[0..MaxBob] of LocationRec;ππ Counter1 : Integer;π Counter2 : Integer;ππ{-[ Set VGA Mode 13h (320 X 200 X 256 Chain 4) ]------------------------}πProcedure SetMode13h; Assembler;πASMπ MOV AX, $13π INT $10πEnd;π{-[ Put A 16 X 16 Image by ORing it With Background ]-------------------}πProcedure Put16X16ImageOR (Var Bob : ImageArray;π X, Y : Integer);πVar CounterX,π CounterY : Integer;πBeginπ For CounterY := 0 to 15 doπ For CounterX := 0 to 15 doπ WorkPage^[CounterY + Y, CounterX + X] :=π WorkPage^[CounterY + Y, CounterX + X] OR Bob[CounterX, CounterY];πEnd;π{-[ Update Bob Positions ]----------------------------------------------}πProcedure UpdateBobs;πVar BobCounter : Integer;πBeginπ For BobCounter := 0 to MaxBob doπ Beginπ Inc (Counter1, 1);π While (Counter1 >= 360) doπ Dec(Counter1, 360);ππ If (Counter1 MOD 2) = 0π Thenπ Beginπ Inc(Counter2,1);π While (Counter2 >= 360) doπ Dec(Counter2, 360);π End;ππ BobLocation[BobCounter].X := 160 +π Round(90 * -Sin((Counter1 + (BobCounter*Counter2))*PI/180));ππ BobLocation[BobCounter].Y := 95 +π Round(60 * Cos((Counter2 + (BobCounter*Counter1))*PI/180));ππ End;πEnd;π{-[ Draw All Bobs To Work Buffer ]--------------------------------------}πProcedure DrawBobs;πVar BobCounter : Integer;πBeginπ For BobCounter := 0 to MaxBob doπ Put16X16ImageOR (BobImage[BobCounter],π BobLocation[BobCounter].X, BobLocation[BobCounter].Y);πEnd;π{-[ Initialize Variables ]----------------------------------------------}πProcedure InitializeVariables;πConst Tbl : Array [0..MaxBob] of Byte = (8, 16, 32);πVar BobCounter : Integer;π CX, CY : Integer;πBeginπ { Make Individual Bobs From Template }π For BobCounter := 0 to MaxBob doπ Beginπ BobImage[BobCounter] := BobTemplate;ππ For CY := 0 to 15 doπ For CX := 0 to 15 doπ If BobImage[BobCounter][CX,CY] <> 0π Thenπ BobImage[BobCounter][CX,CY] :=π BobImage[BobCounter][CX,CY] OR Tbl[BobCounter];π End;ππ Counter1 := 0;π Counter2 := 0;πEnd;π{-[ Build Palette ]-----------------------------------------------------}πProcedure BuildPalette;πVar ColorCounter : Integer;πBeginπ { Initialize Palette Buffer To All Black }π FillChar (Pal, SizeOf(Pal), 0);ππ For ColorCounter := 0 to 7 doπ Beginπ { Make Red, Green, and Blue Bobs }π Pal[ColorCounter OR 08].Red := 21 + (ColorCounter * 6);π Pal[ColorCounter OR 16].Green := 21 + (ColorCounter * 6);π Pal[ColorCounter OR 32].Blue := 21 + (ColorCounter * 6);ππ { Make Colors Where Red and Green Bobs Overlap }π Pal[ColorCounter OR 08 OR 16].Red := 21 + (ColorCounter * 6);π Pal[ColorCounter OR 08 OR 16].Green := 21 + (ColorCounter * 6);ππ { Make Colors Where Red and Blue Bobs Overlap }π Pal[ColorCounter OR 08 OR 32].Red := 21 + (ColorCounter * 6);π Pal[ColorCounter OR 08 OR 32].Blue := 21 + (ColorCounter * 6);ππ { Make Colors Where Green and Blue Bobs Overlap }π Pal[ColorCounter OR 16 OR 32].Green := 21 + (ColorCounter * 6);π Pal[ColorCounter OR 16 OR 32].Blue := 21 + (ColorCounter * 6);ππ { Make Colors Where Red, Green and Blue Bobs Overlap }π Pal[ColorCounter OR 08 OR 16 OR 32].Red := 21+(ColorCounter * 6);π Pal[ColorCounter OR 08 OR 16 OR 32].Green := 21+(ColorCounter * 6);π Pal[ColorCounter OR 08 OR 16 OR 32].blue := 21+(ColorCounter * 6);π End;ππ { Make Colors Where The Grey Square Overlaps The Bobs }π For ColorCounter := 128 to 255 doπ Beginπ Pal[ColorCounter].Red := (Pal[ColorCounter-128].Red DIV 4)+14;π Pal[ColorCounter].Green := (Pal[ColorCounter-128].Green DIV 4)+14;π Pal[ColorCounter].Blue := (Pal[ColorCounter-128].Blue DIV 4)+14;π End;πEnd;π{-[ Draw Grey Square In Background Buffer ]-----------------------------}πProcedure BuildBackground;πVar Y, X : Integer;πBeginπ FillChar (BackGround^, SizeOf(BackGround^), 0);ππ For Y := 50 to 150 doπ For X := 100 to 220 doπ BackGround^[Y, X] := 128;ππEnd;π{=[ Main Program ]======================================================}πBeginπ VGA := Ptr ($A000,$0000);π New (WorkPage);π New (BackGround);ππ InitializeVariables;π BuildPalette;π BuildBackground;ππ SetMode13h;π SetPalette (Pal);ππ Repeatπ UpdateBobs; { Update Bob Positions }π WorkPage^ := BackGround^; { Clear WorkPage With Static Image }π DrawBobs; { Draw Bobs }ππ { Wait For Retrace }π Repeat Until ((Port[$3DA] AND 8) <> 0);ππ VGA^ := WorkPage^; { Display Page }π Until KeyPressed;ππ TextMode (C80);ππ Dispose (BackGround);π Dispose (WorkPage);πEnd.ππ{ PALETTE CODE FOLLOWS }ππ{π TD> I've seen it done in many places, but I haven't seen any info onπ TD> how it's done: What is the basic algorithm for fading from oneπ TD> palette to another.ππ Many people do palette fading incorrectly. The correctπway to do it would be to set up a relation such as:ππ Palette_Element Calculated_Elementπ --------------- = ------------------π Max_Intensity Current_IntensityππWhere Palette_Element is a single element in our master DACπtable, Max_Intensity is the maximum allowable intensity level forπour scale, Current_Intensity is a number between 0 andπMax_Intensity which represents the level we want, andπCalculated_Element is the new value for the element of our DACπtable. But since we want the Calculated_Element, we re-write itπas this equation:ππ Calculated_Element = Palette_Element * Current_Intensityπ -----------------------------------π Max_IntensityππThe above equation will allow us to fade a given palette set toπblack or from black to a given palette set. To fade out an entireπpalette set, you would need to calculate the above for the red,πgreen, and blue components of each color in the 256 element DACπtable.π Fading from one palette set to another palette set isπvery similar. What you must do is fade one palette set to blackπwhile simultaneously fade from black to another palette set andπadd the two values. The equation for this is:ππ CE = ((PE1 * (MI - CI)) + (PE2 * CI)) / MIππWhere CE is the calculated element, PE1 and PE2 are correspondingπpalette elements from palette 1 and 2, MI is the maximumπintensity in our scale, and CI is the current intensity we wantπ(num between 0 and MI). }ππUnit Palette;π{ Programmed By David Dahl @ FidoNet 1:272/38 }π(* PUBLIC DOMAIN *)πInterfaceπ Type PaletteRec = Recordπ Red : Byte;π Green : Byte;π Blue : Byte;π End;π PaletteArray = Array [0..255] of PaletteRec;ππ Procedure SetPalette (Var PaletteIn : PaletteArray);π Procedure FadeFromPaletteToBlack (Var PaletteIn : PaletteArray);π Procedure FadeFromBlackToPalette (Var PaletteIn : PaletteArray);π Procedure FadeFromPalette1ToPalette2 (Var Palette1 : PaletteArray;π Var Palette2 : PaletteArray);πImplementationπProcedure SetPalette (Var PaletteIn : PaletteArray); Assembler;πAsmπ { Get Address of PaletteIn }π LDS SI, PaletteInπ CLDππ { Tell VGA To Start With First Palette Element }π XOR AX, AX π MOV DX, $3C8π OUT DX, ALππ { Wait For Retrace }π MOV DX, $3DAπ @VRWait1:π IN AL, DXπ AND AL, 8π JZ @VRWait1π π { Set First Half Of Palette }π MOV DX, $3C9π MOV CX, 128 * 3π @PALLOOP1:π LODSB { DON'T use "REP OUTSB" since some VGA cards can't handle it }π OUT DX, ALπ LOOP @PALLOOP1ππ { Wait For Retrace }π PUSH DXπ MOV DX, $3DAπ @VRWait2:π IN AL, DXπ AND AL, 8π JZ @VRWait2π POP DXππ { Set Last Half Of Palette }π MOV CX, 128 * 3π @PALLOOP2:π LODSBπ OUT DX, ALπ LOOP @PALLOOP2πEnd;ππProcedure FadeFromPaletteToBlack (Var PaletteIn : PaletteArray);πVar WorkPalette : PaletteArray;π Counter : Integer;π Intensity : Integer;πBeginπ For Intensity := 31 downto 0 do π Beginπ For Counter := 0 to 255 doπ Beginπ WorkPalette[Counter].Red := π (PaletteIn[Counter].Red * Intensity) DIV 32;π WorkPalette[Counter].Green := π (PaletteIn[Counter].Green * Intensity) DIV 32;π WorkPalette[Counter].Blue := π (PaletteIn[Counter].Blue * Intensity) DIV 32;π End;π SetPalette (WorkPalette);π End;πEnd;ππProcedure FadeFromBlackToPalette (Var PaletteIn : PaletteArray);πVar WorkPalette : PaletteArray;π Counter : Integer;π Intensity : Integer;πBeginπ For Intensity := 1 to 32 do π Beginπ For Counter := 0 to 255 doπ Beginπ WorkPalette[Counter].Red := π (PaletteIn[Counter].Red * Intensity) DIV 32;π WorkPalette[Counter].Green := π (PaletteIn[Counter].Green * Intensity) DIV 32;π WorkPalette[Counter].Blue := π (PaletteIn[Counter].Blue * Intensity) DIV 32;π End;π SetPalette (WorkPalette);π End;πEnd;ππProcedure FadeFromPalette1ToPalette2 (Var Palette1 : PaletteArray;π Var Palette2 : PaletteArray);πVar WorkPalette : PaletteArray;π Counter : Integer;π CrossFade : Integer;πBeginπ For CrossFade := 0 to 32 doπ Beginπ For Counter := 0 to 255 doπ Beginπ WorkPalette[Counter].Red :=π ((Palette1[Counter].Red * (32 - CrossFade)) + π (Palette2[Counter].Red * CrossFade)) DIV 32;π WorkPalette[Counter].Green :=π ((Palette1[Counter].Green * (32 - CrossFade)) + π (Palette2[Counter].Green * CrossFade)) DIV 32;π WorkPalette[Counter].Blue :=π ((Palette1[Counter].Blue * (32 - CrossFade)) + π (Palette2[Counter].Blue * CrossFade)) DIV 32;π End;π SetPalette (WorkPalette);π End;πEnd;πEnd.ππTUTORIAL !!ππ Transparent objects are rather simple. What you do isπset up your palette so pure colors are represented by powers ofπtwo. This way you can "mix" your colors by ORing the valuesπtogether. For simplicity's sake, this example will use 3 colors:ππ Bit 7 6 5 4 3 2 1 0π | | |π | | +----> Redπ | +------> Greenπ +--------> BlueππSo now you would set your palette up as follows:ππ All single colors:ππ 2^0 = 1 -- Redπ 2^1 = 2 -- Greenπ 2^2 = 4 -- Blueππ All possible 2 color mixes:ππ 2^0 OR 2^1 = 1 OR 2 = 3 -- Red + Green = Yellowπ 2^0 OR 2^2 = 1 OR 4 = 5 -- Red + Blue = Magentaπ 2^1 OR 2^2 = 2 OR 4 = 6 -- Green + Blue = Cyanππ All possible 3 color mixes:ππ 2^0 OR 2^1 OR 2^2 = 1 OR 2 OR 4 = 7 -- R + G + B = WhiteππSo our palette is set up as:ππ 0 - Blackπ 1 - Redπ 2 - Greenπ 3 - Yellowπ 4 - Blueπ 5 - Magentaπ 6 - Cyanπ 7 - WhiteππNow let's say we have a Red, Green, and a Blue square. Theπbitmap of the red square will be made up of bytes of the value 1,πthe green square will be made up of the value 2, and the blueπsquare will be made up of the value 4 as so:ππ Red Green Blueππ 11111111 22222222 44444444π 11111111 22222222 44444444π 11111111 22222222 44444444π 11111111 22222222 44444444ππTo put the squares, you just have to OR put them to your frameπbuffer. If they overlap, they will automatically mix as so:ππ The 3 overlaping bitmaps The 3 overlaping bitmapsπ in frame buffer using an in frame buffer showingπ OR'd image put: what colors are where:ππ 11111111 RRRRRRRRπ 11111111 RRRRRRRRπ 111133332222 RRRRYYYYGGGGπ 155577776222 RMMMWWWWCGGGπ 44466666222 BBBCCCCCGGGπ 44466666222 BBBCCCCCGGGπ 44444444 BBBBBBBBππThe following example program uses this bit scheme:ππ Bit 7 6 5 4 3 2 1 0π | | | | +-+-+---> Color Intensity (0:Least - 7:Full)π | | | +---------> Redπ | | +-----------> Greenπ | +-------------> Blueπ +-----------------> GreyπππDavid Dahl 20 08-24-9417:53ALL LEW ROMNEY VGA-TEXT-FONT-EDITOR SWAG9408 C½ 28 Üd {πDL> When i redefine a character as "─", i don't get a smooth line, but oneπDL> pixel left blank between every character, so "---" instead of "───".ππWith EGA, everything used to be so simple: all characters are 8x16 bits.ππWith VGA, there's an odd difference; you'll love this story. Somebody inπIBM once said, "Why not do our share in making this universe a completeπchaos, and thus implement an infuriating and highly illogical technologicalπmess in this new system we're calling VGA?" Of course. The brilliant newπinvetion, ladies and germs, was the 9th vertical line. It's all gone intoπthe history books by now; it tooks months and truckloads of money just toπthink it up but as always, IBM succeeded.ππNow, all characters in the VGA font set are 8 bits, or pixels, wide.πExcept for 24 characters, 192 through 216 in ASCII. These characters haveπan additional vertical line; no problem. The truly ingenious touch (as theπlesser-known Harry Stottle of the celebrated IBM Vertical Line Team said,π"Eureka!") is how this addition line is actually a copy of the 8th.ππIe., to make a horizontal line ('─'), use any of the characters 192-216 andπactivate 8 bits from left to right. The 8th bit is copied to the 9th, andπyou've got a horizontal line.ππAnd here the tale endeth. Almost. For it leaves to each haplessπprogrammer to figure this out and now I told you. Pass the tale on as theπlast oral tradition of the cybernetic age.ππLest we forget.ππDL> 1 2 3 4 5 6 7 8 I believe the way to get this right, is toπDL> ┌─┬─┬─┬─┬─┬─┬─┬─┐ repeat column 8 (x).πDL> 1│ │ │ │ │ │ │ │x│ However, i don't know how to do this...πDL> 2│ │ │ │ │ │ │ │x│πDL> 3│ │ │ │ │ │ │ │x│πDL> 4│ │ │ │ │ │ │ │x│πDL> : : : : : : : : :πDL> 15│ │ │ │ │ │ │ │x│πDL> 16│ │ │ │ │ │ │ │x│ Please help,πDL> └─┴─┴─┴─┴─┴─┴─┴─┘ Dirk Loeckx. [@]ππDon't forget, too: use IN/OUT or Port/PortW to program the video card. Ifπyou use the BIOS routines, you'll generate flicker (even on a VGA card) andπstress that poor old card. In case you missed those routines in SWAG, hereπare my versions:ππ procedure PutFontC (C : Char; var Data);π {-Define font character bitmap}π beginπ inline($FA);π PortW[$3C4]:=$0402;π PortW[$3C4]:=$0704;π PortW[$3CE]:=$0204;π PortW[$3CE]:=$0005;π PortW[$3CE]:=$0006;π Move(Data, Mem[SegA000:Byte(C) * 32], 16);π PortW[$3C4]:=$0302;π PortW[$3C4]:=$0304;π PortW[$3CE]:=$0004;π PortW[$3CE]:=$1005;π PortW[$3CE]:=$0E06;π inline($FB);π end;ππ procedure GetFontC (C : Char; var Data);π {-Retrieve font character bitmap}π beginπ inline($FA);π PortW[$3C4]:=$0402;π PortW[$3C4]:=$0704;π PortW[$3CE]:=$0204;π PortW[$3CE]:=$0005;π PortW[$3CE]:=$0006;π Move(Mem[SegA000:Byte(C) * 32], Data, 16);π PortW[$3C4]:=$0302;π PortW[$3C4]:=$0304;π PortW[$3CE]:=$0004;π PortW[$3CE]:=$1005;π PortW[$3CE]:=$0E06;π inline($FB);π end;ππ(If you are using TP versions earlier than 7.0, replace "SegA000" withπ"$A000"... but you knew that.)ππ ttyl, Lew.π lew.romney@thcave.bbs.noπ 21 08-24-9417:54ALL OLAF BARTELT Text Font Routines SWAG9408 ΩsΘL 58 Üd πUNIT video;ππINTERFACEππUSES DOS;ππTYPE fontSize = (font8,font14,font16, unknownFontSize);π adapterType = (none,mda,cga,egaMono,egaColor,vgaMono,π vgaColor,mcgaMono,mcgaColor);ππVAR textBufferOrigin : pointer; {pointer to text buffer}π textBufferSeg : word;π textBufferSize : word; {size in bytes of...}π visibleX,visibleY : byte;π fontLines : byte;ππfunction queryAdapterType : adapterType;πfunction fontCode(h : byte) : fontSize; {convert from byte to enum}πfunction getFontSize : fontSize; {normal 25 lines,ega 25 lines,vga 25 lines}πfunction fontHeight(f : fontSize) : byte;πprocedure getTextBufferStats(var BX : byte; {visible x dimentions}π var BY : byte; {visible y dimentions}π var buffSize : word {refresh buffer size}π );πconst maxX : integer = 79;π maxY : integer = 24;ππIMPLEMENTATIONππ(******************************************************************************π* queryAdapterType *π******************************************************************************)πfunction queryAdapterType : adapterType;ππvar regs : Registers;π code : byte;ππbeginπ regs.ah := $1a; {vga identify}π regs.al := $0; {clear}π intr($10,regs);π if regs.al = $1a then { is this a bug ???? }π begin {ps/2 bios search for ..}π case regs.bl of {code back in here}π $00 : queryAdapterType := none;π $01 : queryAdapterType := mda;π $02 : queryAdapterType := cga;π $04 : queryAdapterType := egaColor;π $05 : queryAdapterType := egaMono;π $07 : queryAdapterType := vgaMono;π $08 : queryAdapterType := vgaColor;π $0A,$0C : queryAdapterType := mcgaColor;π $0B : queryAdapterType := mcgaMono;π else queryAdapterType := cga;π end; {case}π end {ps/2 search}π elseπ begin {look for ega bios}π regs.ah := $12;π regs.bx := $10; {bl=$10 retrn ega info if ega}π intr($10,regs);π if regs.bx <> $10 then {bx unchanged mean no ega}π beginπ regs.ah := $12; {ega call again}π regs.bl := $10; {recheck}π intr($10,regs);π if (regs.bh = 0) thenπ queryAdapterType := egaColorπ elseπ queryAdapterType := egaMono;π end {ega identification}π else {mda or cga}π beginπ intr($11,regs); {get eqpt.}π code := (regs.al and $30) shr 4;π case code ofπ 1,2 : queryAdapterType := cga;π 3 : queryAdapterType := mda;π else queryAdapterType := none;π end; {case}π end {mda, cga}π end;πend; {quertAdapterType}ππ(******************************************************************************π* getTextBufferStats *π* return bx = #of columns, by = #of rows, buffSize = #of bytes in buffer *π******************************************************************************)πprocedure getTextBufferStats;πconst screenLineMatrix : array[adapterType,fontSize] of integer =π ( (25,25,25, -1) {none adapter}, (-1,25,-1, -1) {mda},π (25,-1,-1, -1) {cga},(43,25,-1, -1) {egaMono}, (43,25,-1, -1) {egaColor},π (50,28,25, -1) {vgaMono}, (50,28,25, -1) {vgaColor},π (-1,-1,25, -1) {mcgaMono}, (-1,-1,25, -1) {mcgaColor} );π{this matrix is saved in font8,font14,font16 sequence in rows of matrix}πvarπ regs:registers;πbeginπ regs.ah := $0f; {get current video mode}π intr($10,regs);π bx := regs.ah; {# of chars in a line, row}π by := screenLineMatrix[queryAdapterType, getFontSize];π if by > 0 then {legal height}π buffSize := bx * 2 * byπ elseπ buffSize := 0;πend; {getTextBufferStats}ππ(******************************************************************************π* getFontSize *π******************************************************************************)πfunction getFontSize : fontSize;πvarπ regs : registers;π fs : fontSize;π at : adapterType;πbeginπ at := queryAdapterType;π case at ofπ cga : fs := font8;π mda : fs := font14;π mcgaMono,π mcgaColor : fs:= font16;π egaMono,π egaColor,π vgaMono,π vgaColor : beginπ with regs do beginπ (* check this interrupt call, there might be some bug,π either in the call conventions, or in the 3300Aπ bios. *)π ah := $11; {egavga call}π al := $30;π(* bl := $0; *)π bh := $0;π end; {with}π intr($10,regs);π fs := fontCode(regs.cl);π if (fs = unknownFontSize) thenπ fs := font16; { assume a work around in 330A screen}π end; {ega vga}π end; {case}π getFontSize := fs;πend; {getFontSize}ππ(******************************************************************************π* fontCode *π* Convert from byte size to a fontSize type *π******************************************************************************)πfunction fontCode;πbeginπ case h ofπ 8 : fontCode := font8;π 14 : fontCode := font14;π 16 : fontCode := font16;π else fontCode := unknownFontSize; { unKnown, assume 8 }π end; {case}πend; {fontCode}ππ(******************************************************************************π* fontHeight *π******************************************************************************)πfunction fontHeight(f : fontSize) : byte;πbeginπ case f ofπ font8 : fontHeight := 8;π font14 : fontHeight := 14;π font16 : fontHeight := 16;π end; {case}πend; {fontHeight}ππbeginπ getTextBufferStats(visibleX, visibleY, textBufferSize);π maxX := visibleX - 1;π maxY := visibleY - 1;π fontLines := fontHeight(getFontSize);πend.π 22 08-25-9409:09ALL JAMIE MORTIMER Map Drawing SWAG9408 ┼V╢ 37 Üd (*πI have *really* simple code I wrote for loading a 320x200x256 pcx ifπthat'd do. I have other stuff that you could work with, but it's notπmine and not finished.ππCL/ Display a background .PCX (a map in this case), and allow for theπCL/movement of foreground objects w/o affecting the background .PCX.ππWhat you want to do is use virtual screens or page flipping, dependingπon the graphic mode. If you're in low res (really easy!) 320x200x256,πyou can easily use 64k virtual screens (just arrays of [0..199,0..319]πfor simplicity) and treat *them* like a screen. Then dump them to theπreal screen once all your updates are done. For higher vid modes,πvirtual screens can get a *bit* more complex, 'specially for 16 colorπmodes.ππCL/Item_REc = recπCL/ name : string [30];πCL/ amt : byte;πCL/ end;πCL/Item_Type = array[1..5] of Item_Rec;ππCL/Map_Rec = RecordπCL/ Occupant : Byte; { Player=1, Nobody=0, etc }πCL/ Items : Item_type;πCL/ Case Terrain:Char ofπCL/ 'F' : etc,etc...πCL/ End; { Map_rec }πCL/map_type = array[1..100,1..100] of map_rec;ππCL/varπCL/ Map : map_type;ππWell, the list of items should be link listed. I mean, not *every* mapπwill always have 5 items, right? Save memory that way. Also, useπitem numbers instead of signifying an item by it's entire name. Usingπa record structure something like this might help a bit:π*)ππTypeπ PItemRec = ^ItemRec;π ItemRec = recordπ name : string[28];π idnum : word;π next : PItemRec;π end; {ItemRec 35 bytes}ππ PItemIdx = ^ItemIdx;π ItemIdx = recordπ idnum : word; {maximum of ~65535 items, depending on mem}π amt : Byte;π next : PItemIdx;π end; {ItemIdx 7 bytes }ππ PPlayerIdx = ^PlayerIdxπ PlayerIdx = recordπ idnum : word;π next : PPlayerIdxπ end; {PlayerIdx 6 bytes} {This will allow for more than one playerπ on a map coord if you want. Just an idea}ππ Map_Rec = Recordπ Occupants : PPlayerIdx; {list of players}π Items : PItemIdx; {list of items}π Case Terrain:char etcπ End; { Map_rec 9 bytes}ππ{If you only want one player per square at a time, you can changeπoccupants to type byte, makeing map_rec 6 bytes, increasing your maximumπmap size by like 1/3ππAgain, you could do linked lists for the map, but I'm sure you won'tπhave *that* big a map... 85x85 should be ok, right?π}ππ pmap_type = ^Map_Type; {This will save your data segment some room}π map_type = array[1..85,1..85] of map_rec; {with 9 byte maprec}π map_type = array[1..104,1..104] of map_rec; {with 6 byte maprec}ππ{here's some examples of how to access these variables}ππProcedure AddItem(NewName:string;NewId:Word;Var List:PItemIdx);πvarπ NewItem:PItemRec;πbeginπ New(Newitem); {alloc mem for new item}π with newitem^ doπ beginπ name:=newname;π Idnum:=newid;π Next:=List; {chain "list" after newitem}π end;π List:=NewItem; {Insert into front of list}πend;ππVarπ Map : PMap_Type;π ItemList : PItemRec;π t,i : integer;π pPlr : PPlayerIdx;π pItm : PItemIdx;ππbeginπ new(map); { get heap memory for the MAP pointer}π ItemList:=nil; { no items in master list yet}ππ fillchar(map^,sizeof(map^),0); { clear *ALL* map memory to zeros }ππ {Make some arbitary items}π Additem('Sword',0,ItemList);π Additem('Shield',1,ItemList);π Additem('Dagger',2,ItemList);π Additem('Helm',3,ItemList);ππ For T:=1 to 85 doπ for I:=1 to 85 doπ beginπ terrain:=terraintypes[random(10)]; {whatever}π if random(100) thenπ beginπ new(pitm); {make a new item idex}π with pitm^ doπ beginπ idnum:=random(4);π amt:=1;π next:=nil;π end;π Map^[t,i].items^:=pitm;π end;π end;ππ{these next lines should clean up the entire map, no matter how manyπitems, players or whatever you have around. As long as you don't haveπany invalid pointers...<G>}ππ For T:=1 to 85 doπ for I:=1 to 85 doπ beginπ while occupant<>nil doπ beginπ pplr:=occupant;π occupant:=occupant^.next;π dispose(pplr);π end;π while items<>nil doπ beginπ pitm:=items;π items:=items^.next;π dispose(pitm);π end;π end;π dispose(map); { free heap memory for the MAP pointer}πend.ππ 23 08-25-9409:11ALL LEON DEBOER CatMull-Rom spline sourceSWAG9408 ╨ a( 56 Üd {πFrom: ldeboer@cougar.multiline.com.au (Leon DeBoer)ππ{------------------------------------------------------------------------}π{ Catmull_Rom and BSpline Parametric Spline Program }π{ }π{ All source written and devised by Leon de Boer, (c)1994 }π{ E-Mail: ldeboer@cougar.multiline.com.au }π{ }π{ After many request and talk about spline techniques on the }π{ internet I decided to break out my favourite spline programs and }π{ donate to the discussion. }π{ }π{ Each of splines is produced using it's parametric basis matrix }π{ }π{ B-Spline: }π{ -1 3 -3 1 / }π{ 3 -6 3 0 / }π{ -3 0 3 0 / 6 }π{ 1 4 1 0 / }π{ }π{ CatMull-Rom: }π{ -1 3 -3 1 / }π{ 2 -5 4 -1 / }π{ -1 0 1 0 / 2 }π{ 0 2 0 0 / }π{ }π{ The basic differences between the splines: }π{ }π{ B-Splines only passes through the first and last point in the }π{ list of control points, the other points merely provide degrees of }π{ influence over parts of the curve (BSpline in green shows this). }π{ }π{ Catmull-Rom splines is one of a few splines that actually pass }π{ through each and every control point the tangent of the curve as }π{ it passes P1 is the tangent of the slope between P0 and P2 (The }π{ curve is shown in red) }π{ }π{ There is another spline type that passes through all the }π{ control points which was developed by Kochanek and Bartels and if }π{ anybody knows the basis matrix could they E-Mail to me ASAP. }π{ }π{ In the example shown the program produces 5 random points and }π{ displays the 2 spline as well as the control points. You can alter }π{ the number of points as well as the drawing resolution via the }π{ appropriate parameters. }π{------------------------------------------------------------------------}ππPROGRAM Spline;ππUSES Graph;ππTYPEπ Point3D = Recordπ X, Y, Z: Real;π End;ππVAR CtrlPt: Array [-1..80] Of Point3D;ππPROCEDURE Spline_Calc (Ap, Bp, Cp, Dp: Point3D; T, D: Real; Var X, Y: Real);πVAR T2, T3: Real;πBEGINπ T2 := T * T; { Square of t }π T3 := T2 * T; { Cube of t }π X := ((Ap.X*T3) + (Bp.X*T2) + (Cp.X*T) + Dp.X)/D; { Calc x value }π Y := ((Ap.Y*T3) + (Bp.Y*T2) + (Cp.Y*T) + Dp.Y)/D; { Calc y value }πEND;ππPROCEDURE BSpline_ComputeCoeffs (N: Integer; Var Ap, Bp, Cp, Dp: Point3D);πBEGINπ Ap.X := -CtrlPt[N-1].X + 3*CtrlPt[N].X - 3*CtrlPt[N+1].X + CtrlPt[N+2].X;π Bp.X := 3*CtrlPt[N-1].X - 6*CtrlPt[N].X + 3*CtrlPt[N+1].X;π Cp.X := -3*CtrlPt[N-1].X + 3*CtrlPt[N+1].X;π Dp.X := CtrlPt[N-1].X + 4*CtrlPt[N].X + CtrlPt[N+1].X;π Ap.Y := -CtrlPt[N-1].Y + 3*CtrlPt[N].Y - 3*CtrlPt[N+1].Y + CtrlPt[N+2].Y;π Bp.Y := 3*CtrlPt[N-1].Y - 6*CtrlPt[N].Y + 3*CtrlPt[N+1].Y;π Cp.Y := -3*CtrlPt[N-1].Y + 3*CtrlPt[N+1].Y;π Dp.Y := CtrlPt[N-1].Y + 4*CtrlPt[N].Y + CtrlPt[N+1].Y;πEND;ππPROCEDURE Catmull_Rom_ComputeCoeffs (N: Integer; Var Ap, Bp, Cp, Dp: Point3D);πBEGINπ Ap.X := -CtrlPt[N-1].X + 3*CtrlPt[N].X - 3*CtrlPt[N+1].X + CtrlPt[N+2].X;π Bp.X := 2*CtrlPt[N-1].X - 5*CtrlPt[N].X + 4*CtrlPt[N+1].X - CtrlPt[N+2].X;π Cp.X := -CtrlPt[N-1].X + CtrlPt[N+1].X;π Dp.X := 2*CtrlPt[N].X;π Ap.Y := -CtrlPt[N-1].Y + 3*CtrlPt[N].Y - 3*CtrlPt[N+1].Y + CtrlPt[N+2].Y;π Bp.Y := 2*CtrlPt[N-1].Y - 5*CtrlPt[N].Y + 4*CtrlPt[N+1].Y - CtrlPt[N+2].Y;π Cp.Y := -CtrlPt[N-1].Y + CtrlPt[N+1].Y;π Dp.Y := 2*CtrlPt[N].Y;πEND;ππPROCEDURE BSpline (N, Resolution, Colour: Integer);πVAR I, J: Integer; X, Y, Lx, Ly: Real; Ap, Bp, Cp, Dp: Point3D;πBEGINπ SetColor(Colour);π CtrlPt[-1] := CtrlPt[1];π CtrlPt[0] := CtrlPt[1];π CtrlPt[N+1] := CtrlPt[N];π CtrlPt[N+2] := CtrlPt[N];π For I := 0 To N Do Beginπ BSpline_ComputeCoeffs(I, Ap, Bp, Cp, Dp);π Spline_Calc(Ap, Bp, Cp, Dp, 0, 6, Lx, Ly);π For J := 1 To Resolution Do Beginπ Spline_Calc(Ap, Bp, Cp, Dp, J/Resolution, 6, X, Y);π Line(Round(Lx), Round(Ly), Round(X), Round(Y));π Lx := X; Ly := Y;π End;π End;πEND;ππPROCEDURE Catmull_Rom_Spline (N, Resolution, Colour: Integer);πVAR I, J: Integer; X, Y, Lx, Ly: Real; Ap, Bp, Cp, Dp: Point3D;πBEGINπ SetColor(Colour);π CtrlPt[0] := CtrlPt[1];π CtrlPt[N+1] := CtrlPt[N];π For I := 1 To N-1 Do Beginπ Catmull_Rom_ComputeCoeffs(I, Ap, Bp, Cp, Dp);π Spline_Calc(Ap, Bp, Cp, Dp, 0, 2, Lx, Ly);π For J := 1 To Resolution Do Beginπ Spline_Calc(Ap, Bp, Cp, Dp, J/Resolution, 2, X, Y);π Line(Round(Lx), Round(Ly), Round(X), Round(Y));π Lx := X; Ly := Y;π End;π End;πEND;ππVAR I, J, Res, NumPts: Integer;πBEGINπ I := Detect;π InitGraph(I, J, 'e:\bp\bgi');π I := GetMaxX; J := GetMaxY;π Randomize;π CtrlPt[1].X := Random(I); CtrlPt[1].Y := Random(J);π CtrlPt[2].X := Random(I); CtrlPt[2].Y := Random(J);π CtrlPt[3].X := Random(I); CtrlPt[3].Y := Random(J);π CtrlPt[4].X := Random(I); CtrlPt[4].Y := Random(J);π CtrlPt[5].X := Random(I); CtrlPt[5].Y := Random(J);π Res := 20;π NumPts := 5;π BSpline(NumPts, Res, LightGreen);π CatMull_Rom_Spline(NumPts, Res, LightRed);π SetColor(Yellow);π For I := 1 To NumPts Do Beginπ Line(Round(CtrlPt[I].X-3), Round(CtrlPt[I].Y),π Round(CtrlPt[I].X+3), Round(CtrlPt[I].Y));π Line(Round(CtrlPt[I].X), Round(CtrlPt[I].Y-3),π Round(CtrlPt[I].X), Round(CtrlPt[I].Y+3));π End;π ReadLn;π CloseGraph;πEND.π
